VDOS/UTIL/EDIT 1.61
? "VINTAGE" VCD "VDOSDEV.ABS" VLOAD
LOADING..............................................................................................
Run from 77000 to return

VDOS DEV 1.61
? WORDS
DO +DO INDEx +LOOx >STEx IFNZ IFZ IF<0 ENDIx ELSE UNTIx WHILx CASE = < > <=
>= <> DEFAxxx ENDCxxx EXECxxx WBOOx AND OR XOR ADD SUB INC DEC NOT 2CPL DUP
DROP OVER ROT SWAP GET PUT PNUM CRLF DECIxxx OCTAx BINAxx RADIx SP>S SB>S
XP>S XB>S YP>S YB>S ZP>S ZB>S END EOD DEFIxx DMPS S>SR SR>S PCHR PWRD CHRIx
S>X X>S S>Y Y>S S>Z Z>S MUL ASL ASR ROL ROR DIV RUN X>>Y X>>Z Y>>X Z>>X
$PRIxx $SWAx $CPY $DUP $DROx $LEN $ADR $XTExx $PUT $GET $CRExxx $STR $HEAx
$APPxxx $TAIx $IN $CAT $VAL <>COx >PTP <PTR MSPAxxx MSBOxx MSBIx MSWOxx
MSWIx MS$Oxx MS$Ix MSCRxx >MS <MS MS_Sxxx MS_Rxxxxxx CONSxxx #0 #1 @TL @TB1
@TB2 @ANVxx @LLP @ENSxx @CLH @LITxxxx @STRxxx @RTSxx @DIC @USR @BLK @END
@DIPxx RND TOKEx SDIC +IRQ -IRQ +AUTx -AUTx ADDCxxx INBLxxx OUTBxxxx GETIx
SETIx GETOx SETOx $DEFxxx HEADxxx WORDx ADDHxxxxx ADDHxxxxxx FIXLxxxx
ADDMxxxx VARIxxxx CONSxxxx ALLOxxxx ZEROxxxxx BPUT BGET $EQUxx $SLIxx $TRIx
ABSOxx PTZExx MARKxxx SETCxx GLOBxx DUMP PDEF EXPLxxx FORGxx ERASx FETCx
STASx HIDExxxx RENAxx DELExx UNDExxxx WHERxxx LOAD CREAxx PRESxx DADD D2CPx
EMUL EDIV DSWAx $DVAx $DSTx !DMS -DMS SDMA UDMA UJUMx SJUMx SPAGx C>ACxxx
A>CCxxx USPAxx DMSTxxxx UPTR MSUSxx ABSLxxx GOUSxx GOSYxxxx ALTSxxx ?DMS
ZAM HLT ALTRxx RUNAxx PTHExxxx AAOUx ALTAxx ALTDxxx CLRHxxx ALTHxxx OE OE?
SYSAxx VDOS VSYNx VCLExx <VDR >VDR &SIW &ORF &OWF &WFVxx @GSB @SSB &UCLxxx
USBSxxx @PVLx PVDR $>VDx $>VCxx VECS VPROxxx VDIR VCD VSHOx VDEL USBRxxx
USBAxxxxx USBWxxxx USBCxxxx VOWCxxxx VLOAx VSAVx VCOPx VREAx VWRIxx VCLOxx
UFSIxx VERSxxx _FLG _XFR _LNZ _CNT _MCZ FCAM ?MSOxx _PAD _CBD _TRA AM2Axx
APUT AGET SHAM UNSHxx TTYPx TERMxxxx ESC POS CLS COLOx -COLxx CPAG MPAG
CLIN CCOL GCHR INSM AMTW PDGC PSGC LNLEx MVWA DISL DIBUx GPAGx PPAGx PBYTx
GBYTx UDCHx UDLIx AEBS STMPxx TRCAx AEDIx 78PAx ARLIxxx CKARxxx STTSx STFLx
MALOxx MASAxx CALOxx CALIxx ALOAx PTRMxxx RNWOxx %PUTxx %GETxx &ASMxxxx
&ALGxxxx &FFN &BCS &FP2 &FTDxxx &LDOxx ASMB ALGOx FORTxxx LINK SETBxx
EOD=045243 FREE=014534
? SETBCS
BCS BINARY = BCS.ABS
CHANGE? (Y/N) N
? "REVERSI.FTN" "REVERSI.REL" FORTRAN
LOADING FORTRAN PASS 1 AND OPENING FILES
LOADING..LOADING.....................
RUNNING FORTRAN PASS 1...
AT HALT, SELECT P, SET TO 77000, STORE, RUN
PRESS ANY KEY TO START...
FTN,B,L
      PROGRAM REVERSI
C     6/14/10 WTN
C     CONFIGURED FOR BCS FORTRAN II
C     MODIFIED FROM REVERSIX/Y/Z 11/7/07 12/29/07 7/20/08
E-0004: 0000 +0001
      DIMENSION IBRD(10,10),JBRD(10,40)
      DIMENSION IWTS(10,10),JWTS(10,40)
      DIMENSION JMX(3),JMY(3),JIMG(3),JIMX(3),JIMY(3)
      DIMENSION JIAG(3),KIAG(3),JGAIN(3),JLCTL(3),JPHAS(3)
C-- piece codes for FTN2/F2C
      NEMPT=32
      NHUMN=79
      NMACH=88
C-- piece codes for RTE FTN4
C     NEMPT=1H
C     NHUMN=1HO
C     NMACH=1HX
C make LUR 5 LUW 6 for regular FORTRAN, 1,6 for HP BCS, 1,1 for FTN4
      LUR=1
      LUW=6
C-- Lookahead levels.. 0 = none, 1 = consider next human move,
C--  2 = consider computer move after that, 3 = consider human
C--  move after that.
C-- Start out at level 1, max recursion 2
      LEVEL=1
      MAXRE=2
C-- variable used to help randomize game replays
      ITWDL=0
C-- Weighting factors for middle, side, next to corner,
C-- corner and new next-to-corner for occupied corners
      NMIDL=15
      NSIDE=30
      NEXT2=10
      NCORN=70
      NNX2C=20
C-- Initialize board array
  100 DO 101 I = 1,10
      IBRD(1,I)=0
      IBRD(10,I)=0
      IBRD(I,1)=0
      IBRD(I,10)=0
  101 CONTINUE
      DO 103 J = 2,9
      DO 103 I = 2,9
      IBRD(I,J)=NEMPT
  103 CONTINUE
      IBRD(5,5)=NMACH
      IBRD(6,6)=NMACH
      IBRD(5,6)=NHUMN
      IBRD(6,5)=NHUMN
C-- Initialize weights
      DO 110 I = 1,10
      DO 110 J = 1,10
      IWTS(I,J)=NMIDL
  110 CONTINUE
      DO 120 I = 2,9
      IWTS(I,2)=NSIDE
      IWTS(I,9)=NSIDE
      IWTS(2,I)=NSIDE
      IWTS(9,I)=NSIDE
  120 CONTINUE
      IWTS(3,2)=NEXT2
      IWTS(2,3)=NEXT2
      IWTS(3,3)=NEXT2
      IWTS(8,9)=NEXT2
      IWTS(9,8)=NEXT2
      IWTS(8,8)=NEXT2
      IWTS(8,2)=NEXT2
      IWTS(9,3)=NEXT2
      IWTS(8,3)=NEXT2
      IWTS(2,8)=NEXT2
      IWTS(3,9)=NEXT2
      IWTS(3,8)=NEXT2
      IWTS(2,2)=NCORN
      IWTS(9,9)=NCORN
      IWTS(9,2)=NCORN
      IWTS(2,9)=NCORN
C-- Initialize scores etc
      IME=2
      IYOU=2
      IDEPT=0
      IERRL=0
C-- Print title line and instructions
      WRITE(LUW,1015)
      WRITE(LUW,190)NHUMN,NMACH
  190 FORMAT("-=:REVERSI:=-  YOU=",A1," ME=",A1," MOVES=YX")
C-- Main loop, set phase to 0
  200 IPHAS=0
C-- Display board
      LCTL1=1
      GO TO 1000
C-- if last piece, end of game
  205 IF (IYOU+IME-64)208,300,300
C-- Display move prompt and get move
  208 WRITE(LUW,209)
  209 FORMAT("MOVE: _")
C-- the "_" character suppresses CRLF
      READ(LUR,210)IHY,IHX
  210 FORMAT(I1,I1)
C-- if 99 entered GOTO MENU W/ EXTRA LINE
      NTEMP=IHX+IHY*10
      IF (NTEMP-99)212,398,212
C-- If pass (0) then don't display unchanged board
  212 IERRL=212
      IF (IHY)900,230,215
C-- Check move,if bad move jump to 200 to redisplay board
C-- and prompt again, otherwise flip pieces and jump to 220
  215 GO TO 2000
C-- Display changed board
  220 LCTL1=2
      GO TO 1000
C-- if last piece, end of game
  230 IF (IYOU+IME-64)233,300,300
C-- Generate machine move
  233 WRITE(LUW,234)
  234 FORMAT("THINKING...  _")
C-- 1015 is blank line
C-- bump counter to help randomize moves
  235 ITWDL=ITWDL+1
      IPHAS=1
      LCTL3=1
      GO TO 3000
  240 IERRL=240
      IF (IMY)900,250,242
  242 LX=IMX-1
      LY=IMY-1
      WRITE(LUW,245)LY,LX
  245 FORMAT("MY MOVE IS ",I1,I1)
      GO TO 200
  250 WRITE(LUW,260)
  260 FORMAT("I PASS")
C-- Loop if human moved
      IF (IHY)900,300,200
C-- End of Game
  300 ITWDL=ITWDL+IME
      NTEMP=IME-IYOU
      IF (NTEMP)310,330,350
  310 NTEMP=IYOU-IME
      IF (NTEMP-9)315,315,312
  312 WRITE(LUW,320)NTEMP
      GO TO 400
  315 IF (NTEMP-1)316,317,316
  316 WRITE(LUW,322)NTEMP
      GO TO 400
  317 WRITE(LUW,325)NTEMP
      GO TO 400
  320 FORMAT("YOU WON BY ",I2," PIECES")
  322 FORMAT("YOU WON BY ",I1," PIECES")
  325 FORMAT("YOU WON BY ",I1," PIECE")
  330 WRITE(LUW,340)
  340 FORMAT("IT'S A TIE GAME")
      GO TO 400
  350 IF (NTEMP-9)355,355,352
  352 WRITE(LUW,360)NTEMP
      GO TO 400
  355 IF (NTEMP-1)356,357,356
  356 WRITE(LUW,362)NTEMP
      GO TO 400
  357 WRITE(LUW,365)NTEMP
      GO TO 400
  360 FORMAT("I WON BY ",I2," PIECES")
  362 FORMAT("I WON BY ",I1," PIECES")
  365 FORMAT("I WON BY ",I1," PIECE")
  380 FORMAT(I1)
  390 FORMAT("1)AGAIN 2)WEIGHTS 3)LEVEL 4)DUMP : _")
C-- prompt for end-of-game options
  398 WRITE(LUW,1015)
  400 WRITE(LUW,390)
      READ(LUR,380)NTEMP
      IF (NTEMP-1)401,100,401
  401 IF (NTEMP-2)402,700,402
  402 IF (NTEMP-3)403,800,403
  403 IF (NTEMP-4)600,404,600
C-- dump variables
  404 WRITE(LUW,405)
  405 FORMAT("IBRD ARRAY:")
      DO 407 J = 1,10
      WRITE(LUW,406)IBRD(1,J),IBRD(2,J),IBRD(3,J),IBRD(4,J),
     C IBRD(5,J),IBRD(6,J),IBRD(7,J),IBRD(8,J),IBRD(9,J),IBRD(10,J)
  406 FORMAT(I6,I6,I6,I6,I6,I6,I6,I6,I6,I6)
  407 CONTINUE
      WRITE(LUW,410)
  410 FORMAT("IWTS ARRAY:")
      DO 415 J = 1,10
      WRITE(LUW,406)IWTS(1,J),IWTS(2,J),IWTS(3,J),IWTS(4,J),
     C IWTS(5,J),IWTS(6,J),IWTS(7,J),IWTS(8,J),IWTS(9,J),IWTS(10,J)
  415 CONTINUE
      WRITE(LUW,420)IGAIN,IAG,IMG
      WRITE(LUW,424)IMX,IMY,ITBRK
      WRITE(LUW,427)ITWDL,MX,MY
      WRITE(LUW,430)NEMPT,NHUMN,NMACH
      WRITE(LUW,455)NMIDL,NSIDE,NEXT2
      WRITE(LUW,470)NCORN,NNX2C,IFLIP
      WRITE(LUW,490)IPHAS,LCTL1,LCTL3
      WRITE(LUW,500)LCTL4,LEVEL,MAXRE
      WRITE(LUW,505)IDEPT
      WRITE(LUW,510)JMX
      WRITE(LUW,515)JMY
      WRITE(LUW,520)JIMG
      WRITE(LUW,525)JIMX
      WRITE(LUW,530)JIMY
      WRITE(LUW,535)JIAG
      WRITE(LUW,537)JGAIN
      WRITE(LUW,538)JLCTL
      WRITE(LUW,539)KIAG
  420 FORMAT("IGAIN = ",I6,"  IAG   = ",I6,"  IMG   = ",I6)
  424 FORMAT("IMX   = ",I6,"  IMY   = ",I6,"  ITBRK = ",I6)
  427 FORMAT("ITWDL = ",I6,"  MX    = ",I6,"  MY    = ",I6)
  430 FORMAT("NEMPT = ",I6,"  NHUMN = ",I6,"  NMACH = ",I6)
  455 FORMAT("NMIDL = ",I6,"  NSIDE = ",I6,"  NEXT2 = ",I6)
  470 FORMAT("NCORN = ",I6,"  NNX2C = ",I6,"  IFLIP = ",I6)
  490 FORMAT("IPHAS = ",I6,"  LCTL1 = ",I6,"  LCTL3 = ",I6)
  500 FORMAT("LCTL4 = ",I6,"  LEVEL = ",I6,"  MAXRE = ",I6)
  505 FORMAT("IDEPT = ",I6)
  510 FORMAT("JMX   = ",I6,I6,I6,I6)
  515 FORMAT("JMY   = ",I6,I6,I6,I6)
  520 FORMAT("JIMG  = ",I6,I6,I6,I6)
  525 FORMAT("JIMX  = ",I6,I6,I6,I6)
  530 FORMAT("JIMY  = ",I6,I6,I6,I6)
  535 FORMAT("JIAG  = ",I6,I6,I6,I6)
  537 FORMAT("JGAIN = ",I6,I6,I6,I6)
  538 FORMAT("JLCTL = ",I6,I6,I6,I6)
  539 FORMAT("KIAG  = ",I6,I6,I6,I6)
  600 STOP
C-- input new weights
  690 FORMAT(I2)
  700 WRITE(LUW,710)
  710 FORMAT("ENTER WEIGHTS, MIN 1 MAX 99")
      WRITE(LUW,720)
  720 FORMAT("MIDDLE POSITIONS: _")
      READ(LUR,690)NMIDL
      WRITE(LUW,730)
  730 FORMAT("SIDE POSITIONS: _")
      READ(LUR,690)NSIDE
      WRITE(LUW,740)
  740 FORMAT("NEXT-TO CORNERS: _")
      READ(LUR,690)NEXT2
      WRITE(LUW,750)
  750 FORMAT("CORNERS: _")
      READ(LUR,690)NCORN
      WRITE(LUW,760)
  760 FORMAT("NEXT-TO AFTER CORNER OCCUPIED: _")
      READ(LUR,690)NNX2C
      GO TO 100
C-- input new level
  790 FORMAT(I1)
  800 WRITE(LUW,810)
  810 FORMAT("ENTER PLAY LEVEL (0-3): _")
      READ(LUR,790)LEVEL
C-- with lookahead while looking ahead, this is now important
      IF (LEVEL-4)840,800,800
  840 WRITE(LUW,850)
  850 FORMAT("ENTER RECURSION LIMIT (0-3): _")
      READ(LUR,790)MAXRE
      IF (MAXRE-4)100,840,840
C-- program error
  900 WRITE(LUW,910)IERRL
  910 FORMAT("BUG IN PROGRAM NEAR LINE ",I4)
      GO TO 404
C----------------------------------------------------------
C-- board display "subroutine"
C-- to avoid requiring subprograms, return is handled by
C-- conditional GO TO with LCTL1 set to return item
 1000 WRITE(LUW,1015)
      WRITE(LUW,1011)
      DO 1005 J = 2,9
      K=J-1
      WRITE(LUW,1012)K,IBRD(2,J),IBRD(3,J),IBRD(4,J),
     C IBRD(5,J),IBRD(6,J),IBRD(7,J),IBRD(8,J),IBRD(9,J)
      IF (J-9)1002,1005,1005
 1002 WRITE(LUW,1013)
 1005 CONTINUE
      WRITE(LUW,1014)
      WRITE(LUW,1010)
      WRITE(LUW,1015)
      WRITE(LUW,1016)IYOU,IME
      GO TO (205,230),LCTL1
C-- formatting strings...
 1010 FORMAT("    1   2   3   4   5   6   7   8")
 1011 FORMAT("  .-------------------------------.")
 1012 FORMAT(I1," | ",A1,"   ",A1,"   ",A1,"   ",A1,
     C "   ",A1,"   ",A1,"   ",A1,"   ",A1," | ")
 1013 FORMAT("  |                               |")
 1014 FORMAT("  `-------------------------------'")
 1015 FORMAT(" ")
 1016 FORMAT("YOU: ",I2,"  ME: ",I2)
C----------------------------------------------------------
C-- Human move code
C-- Move to make in IHX,IHY (ref'd 1-8)
C-- If bad move prints "INVALID MOVE" and jumps to 200
C-- If good move, flips pieces and jumps to 220
 2000 CONTINUE
C-- derive internal move numbers from entered move
      MX=IHX+1
      MY=IHY+1
C-- make sure both numbers from 2 to 9
      IF (MX-2)2900,2010,2010
 2010 IF (MY-2)2900,2020,2020
 2020 IF (9-MX)2900,2030,2030
 2030 IF (9-MY)2900,2040,2040
C-- make sure location is empty (IBRD(MX,MY)=NEMPT)
 2040 IF (IBRD(MX,MY)-NEMPT)2900,2050,2900
C-- flip pieces if possible
 2050 IFLIP=1
      LCTL4=1
      GO TO 4000
 2060 IERRL=2060
      IF (IGAIN)900,2900,2070
C-- adjust scores
 2070 IYOU=IYOU+IGAIN+1
      IME=IME-IGAIN
C-- done
      GO TO 220
C-- here if invalid move
 2900 WRITE(LUW,2910)
 2910 FORMAT("INVALID MOVE")
      GO TO 200
C----------------------------------------------------------
C-- Computer move code
C-- "calls" itself to predict human move
C-- LCTL3 controls exit destination
C-- computer move left in IMX, IMY (ref'd 2-9)
 3000 CONTINUE
C-- default no move made, negative gain
      IMY=0
      IMX=0
      IMG=-30000
C-- check every position and pick the move with the most
C-- weighted gain
      DO 3100 MX = 2,9
      DO 3100 MY = 2,9
C-- make sure it's an empty square
      IF (IBRD(MX,MY)-NEMPT)3100,3010,3100
C-- check gain
 3010 LCTL4=2
      IFLIP=0
      GO TO 4000
C-- if no gain move on
 3020 IERRL=3020
      IF (IGAIN)900,3100,3022
C-- calculate adjusted gain based on position
 3022 IGAIN=IGAIN+1
      IAG=IGAIN*IWTS(MX,MY)
C-- bypass lookahead if level 0
      IERRL=3022
      IF (LEVEL)900,3025,3023
C-- look ahead one or more moves and modify IAG
C-- dont lookahead if depth >= max recursion levels
 3023 IF (IDEPT-MAXRE)3200,3025,3025
C-- if adj gain is better than current best in IMG, replace
C-- IMX and IMY with selected move. If tie, ITBRK determines if
C-- replaced (0) or not (1) based on score, gain and a counter
 3025 ITBRK=IAND(IME+IGAIN+ITWDL,1)
      IERRL=3025
      IF (ITBRK)900,3030,3040
 3030 IF (IAG-IMG)3100,3050,3050
 3040 IF (IAG-IMG)3100,3100,3050
 3050 IMG=IAG
      IMX=MX
      IMY=MY
 3100 CONTINUE
C-- end of loop, make best move or pass
      IERRL=3100
      IF (IMY)900,3190,3130
 3130 MX=IMX
      MY=IMY
      IFLIP=1
      LCTL4=3
      GO TO 4000
C-- coredump if an invalid move was selected
 3150 IERRL=3150
      IF (IGAIN)900,900,3155
C-- exit if looking ahead
 3155 IERRL=3155
      IF (LCTL3-1)900,3160,3190
C-- adjust score and exit
 3160 IYOU=IYOU-IGAIN
      IME=IME+IGAIN+1
 3190 GO TO (240,3230,3270,3310),LCTL3
C----- Lookahead Code -------------
C-- this section saves the current board array and variables
C-- then flips side and recursively calls the move gen code
C-- to predict future move(s), adding or subracting score.
C-- Afterwards puts things back and continues at line 3025.
C-- LEVEL controls lookahead level (1-3), must be >0 if here.
C-- recursion level tracked in IDEPT, calling code must limit
 3200 CONTINUE
C-- next level
 3201 IDEPT=IDEPT+1
C-- save arrays
      DO 3210 I = 2,9
      DO 3210 J = 2,9
      K=J+IDEPT*10
      JBRD(I,K)=IBRD(I,J)
      JWTS(I,K)=IWTS(I,J)
 3210 CONTINUE
C-- save variables
      JMX(IDEPT)=MX
      JMY(IDEPT)=MY
      JIMG(IDEPT)=IMG
      JIMX(IDEPT)=IMX
      JIMY(IDEPT)=IMY
      JIAG(IDEPT)=IAG
      JGAIN(IDEPT)=IGAIN
      JLCTL(IDEPT)=LCTL3
      JPHAS(IDEPT)=IPHAS
C-- go ahead and make move
      IFLIP=1
      LCTL4=4
      GO TO 4000
C-- these modified to permit reversing roles
C-- IPHAS must be either 1 or 0
C-- set up and call to predict player move
 3220 IPHAS=1-JPHAS(IDEPT)
      LCTL3=2
      GO TO 3000
C-- calculate adjusted gain if human didn't pass
 3230 KIAG(IDEPT)=JIAG(IDEPT)
      IERRL=3230
      IF (IMY)900,3250,3240
 3240 KIAG(IDEPT)=JIAG(IDEPT)-IMG
C-- if level 1 stop looking ahead (error if level 0)
 3250 IERRL=3250
      IF (LEVEL-1)900,3400,3260
C-- set up and call to predict next computer move
 3260 IPHAS=JPHAS(IDEPT)
      LCTL3=3
      GO TO 3000
C-- calculate adjusted gain if computer didn't pass
 3270 IF (IMY)900,3290,3280
 3280 KIAG(IDEPT)=KIAG(IDEPT)+IMG
C-- if level 2 stop looking ahead (error if level 1)
 3290 IERRL=3290
      IF (LEVEL-2)900,3400,3300
C-- set up and call to predict next human move
 3300 IPHAS=1-JPHAS(IDEPT)
      LCTL3=4
      GO TO 3000
C-- calculate adjusted gain if human didn't pass
 3310 IERRL=3310
      IF (IMY)900,3400,3320
 3320 KIAG(IDEPT)=KIAG(IDEPT)-IMG
C-- restore arrays and variables
 3400 IAG=KIAG(IDEPT)
      DO 3410 I = 2,9
      DO 3410 J = 2,9
      K=J+IDEPT*10
      IBRD(I,J)=JBRD(I,K)
      IWTS(I,J)=JWTS(I,K)
 3410 CONTINUE
      MX=JMX(IDEPT)
      MY=JMY(IDEPT)
      IMG=JIMG(IDEPT)
      IMX=JIMX(IDEPT)
      IMY=JIMY(IDEPT)
      IGAIN=JGAIN(IDEPT)
      LCTL3=JLCTL(IDEPT)
      IPHAS=JPHAS(IDEPT)
      IDEPT=IDEPT-1
C-- jump to calculate adjusted gain
      GO TO 3025
C----------------------------------------------------------
C-- gain/flip "sub", LCTL4 determines return line
C-- Piece to move in MX,MY
C-- If IPHAS=0 then counts NMACH chars until NHUMN encountered
C-- If IPHAS=1 then counts NHUMN chars until NMACH encountered
C-- If IFLIP=0 does not affect array
C-- If IFLIP=1 then flips pieces, if gain sets IBRD(MX,MY) to NHUMN
C--            if IPHAS=0 or sets to NMACH if IPHAS=1
C-- Returns #pieces gained in all directions in IGAIN, not counting
C--  the move piece itself
C-- Also.. if move placed in corners, increases weights of next-to
C--  corners since avoiding them would no longer make sense
 4000 IGAIN=0
      IF (IPHAS)4020,4010,4020
C-- set up for player move
 4010 KPIEC=NHUMN
      KTARG=NMACH
      GO TO 4030
C-- set up for computer move
 4020 KPIEC=NMACH
      KTARG=NHUMN
 4030 CONTINUE
C-- repeat for all 8 directions
      DO 4400 KDIR = 1,8
C-- first determine if direction has another KPIEC to surround
      KX=MX
      KY=MY
C-- branch/loop for each direction
 4050 GO TO (4060,4070,4080,4090,4100,4110,4120,4130),KDIR
 4060 KX=KX+1
      GO TO 4140
 4070 KX=KX+1
      KY=KY+1
      GO TO 4140
 4080 KY=KY+1
      GO TO 4140
 4090 KX=KX-1
      KY=KY+1
      GO TO 4140
 4100 KX=KX-1
      GO TO 4140
 4110 KX=KX-1
      KY=KY-1
      GO TO 4140
 4120 KY=KY-1
      GO TO 4140
 4130 KX=KX+1
      KY=KY-1
C-- stop looking in direction if NEMPT or 0
 4140 IF (IBRD(KX,KY))4180,4400,4180
 4180 IF (IBRD(KX,KY)-NEMPT)4190,4400,4190
C-- keep going in direction if target piece
 4190 IF (IBRD(KX,KY)-KTARG)4200,4050,4200
C-- terminator found, proceed to count gain and flip
 4200 KX=MX
      KY=MY
C-- branch/loop for each direction
 4210 GO TO (4220,4230,4240,4250,4260,4270,4280,4290),KDIR
 4220 KX=KX+1
      GO TO 4300
 4230 KX=KX+1
      KY=KY+1
      GO TO 4300
 4240 KY=KY+1
      GO TO 4300
 4250 KX=KX-1
      KY=KY+1
      GO TO 4300
 4260 KX=KX-1
      GO TO 4300
 4270 KX=KX-1
      KY=KY-1
      GO TO 4300
 4280 KY=KY-1
      GO TO 4300
 4290 KX=KX+1
      KY=KY-1
C-- if not target stop going in this direction
 4300 IF (IBRD(KX,KY)-KTARG)4400,4310,4400
C-- count target pieces and keep going in direction
C-- if IFLIP set, flip pieces along the way
 4310 IGAIN=IGAIN+1
      IF (IFLIP)4320,4210,4320
 4320 IBRD(KX,KY)=KPIEC
      GO TO 4210
 4400 CONTINUE
C-- end of KDIR loop
C-- if IFLIP=0 or IGAIN=0 then exit
      IF (IFLIP)4410,4600,4410
 4410 IERRL=4410
      IF (IGAIN)900,4600,4420
C-- place the player or machine piece
 4420 IBRD(MX,MY)=KPIEC
C-- if corner piece adjust weights
      NTEMP=MX+MY*10
      IF (NTEMP-22)4430,4460,4430
 4430 IF (NTEMP-99)4440,4470,4440
 4440 IF (NTEMP-29)4450,4480,4450
 4450 IF (NTEMP-92)4500,4490,4500
 4460 IWTS(2,3)=NNX2C
      IWTS(3,2)=NNX2C
      IWTS(3,3)=NNX2C
      GOTO 4500
 4470 IWTS(9,8)=NNX2C
      IWTS(8,9)=NNX2C
      IWTS(8,8)=NNX2C
      GOTO 4500
 4480 IWTS(9,3)=NNX2C
      IWTS(8,2)=NNX2C
      IWTS(8,3)=NNX2C
      GOTO 4500
 4490 IWTS(3,9)=NNX2C
      IWTS(2,8)=NNX2C
      IWTS(3,8)=NNX2C
 4500 CONTINUE
C-- more weight adjustments can be added here
 4600 GO TO (2060,3020,3150,3220),LCTL4
C----------------------------------------------------------
      END
      END$
FINISHING PASS 1... DONE
LOADING PASS 2... LOADING......
RUNNING FORTRAN PASS 2...
AT HALT, SELECT P, SET TO 77000, STORE, RUN
PRESS ANY KEY TO START...
?
CLOSING FILES... DONE
REMOVING TEMP FILE... DONE
VDOS DEV 1.61
? "REVERSI.REL" "REVERSI.ABS" LINK
PREPARING REL FILE WITH LIBRARY
Writing USB file --TEMP--.REL
 WAIT...
Closing output buffer
LOADING BCS LINKER AND ATTACHING FILES
LOADING...........RUNNING BCS LINKER...
AT HALT, PRESS RUN AGAIN TO LOAD MORE MODULES
(I.E. IF REL HAS 6 MODULES PRESS RUN 5 TIMES)
AFTER ALL LOADED, SELECT S, SET BIT 2, STORE, RUN
AT NEXT HALT, RUN AGAIN TO OUTPUT ABS
WHEN *END DISPLAYED, HALT, SELECT P, SET TO 77000, STORE, RUN
(IF SR BIT 15 WAS SET TO SUPPRESS, CLEAR FIRST)
PRESS ANY KEY TO START...


  REVER


 02000 12403


*LOAD


  FRMTR


 12404 15014


 00270 00555


  .MAP.


 15015 15050


 00556 00560


  FLOAT


 15051 15055


  .PACK


 15056 15152


 00561 00570


  MPY


 15153 15271


 00571 00574


  DLDST


 15272 15332


 00575 00576


  GETAD


 15333 15346


 00577 00600


  IFIX


 15347 15400


 00601 00603


  .STOP


 15401 15415


  .GOTO


 15416 15436


 00604 00604


  .FLUN


 15437 15447


 00605 00606


  IAND


 15450 15457


  ENDIO


 15460 15466


  CLRIO


 15467 15473


*LST
.IOC.  74126
.SQT.  74103
.MEM.  74075
.BUFR  74277
HALT   74070
REVER  04024
CLRIO  15467
.MAP.  15015
.DIO.  14400
.DTA.  14510
.IOI.  14260
.MPY   15153
.IAR.  14334
.STOP  15401
.GOTO  15416
IAND   15450
.BIO.  14457
.IOR.  14230
.RAR.  14310
OLDIO  12612
.DLD   15272
.DST   15305
.FLUN  15437
.PACK  15056
ENDIO  15460
FLOAT  15051
IFIX   15347
ADRES  00577
GETAD  15333


 *LINKS
 01337 01777


*END

CLOSING FILES... DONE
REMOVING TEMP FILE... DONE
VDOS DEV 1.61
? "REVERSI.ABS" VLOAD
LOADING.........................
Run from 77000 to return

-=:REVERSI:=-  YOU=O ME=X MOVES=YX

  .-------------------------------.
1 |                               |
  |                               |
2 |                               |
  |                               |
3 |                               |
  |                               |
4 |             X   O             |
  |                               |
5 |             O   X             |
  |                               |
6 |                               |
  |                               |
7 |                               |
  |                               |
8 |                               |
  `-------------------------------'
    1   2   3   4   5   6   7   8

YOU:  2  ME:  2
MOVE: 34

  .-------------------------------.
1 |                               |
  |                               |
2 |                               |
  |                               |
3 |             O                 |
  |                               |
4 |             O   O             |
  |                               |
5 |             O   X             |
  |                               |
6 |                               |
  |                               |
7 |                               |
  |                               |
8 |                               |
  `-------------------------------'
    1   2   3   4   5   6   7   8

YOU:  4  ME:  1
THINKING...  MY MOVE IS 53

  .-------------------------------.
1 |                               |
  |                               |
2 |                               |
  |                               |
3 |             O                 |
  |                               |
4 |             O   O             |
  |                               |
5 |         X   X   X             |
  |                               |
6 |                               |
  |                               |
7 |                               |
  |                               |
8 |                               |
  `-------------------------------'
    1   2   3   4   5   6   7   8

YOU:  3  ME:  3
MOVE: 99

1)AGAIN 2)WEIGHTS 3)LEVEL 4)DUMP : 4
IBRD ARRAY:
     0     0     0     0     0     0     0     0     0     0
     0    32    32    32    32    32    32    32    32     0
     0    32    32    32    32    32    32    32    32     0
     0    32    32    32    79    32    32    32    32     0
     0    32    32    32    79    79    32    32    32     0
     0    32    32    88    88    88    32    32    32     0
     0    32    32    32    32    32    32    32    32     0
     0    32    32    32    32    32    32    32    32     0
     0    32    32    32    32    32    32    32    32     0
     0     0     0     0     0     0     0     0     0     0
IWTS ARRAY:
    15    15    15    15    15    15    15    15    15    15
    15    70    10    30    30    30    30    10    70    15
    15    10    10    15    15    15    15    10    10    15
    15    30    15    15    15    15    15    15    30    15
    15    30    15    15    15    15    15    15    30    15
    15    30    15    15    15    15    15    15    30    15
    15    30    15    15    15    15    15    15    30    15
    15    10    10    15    15    15    15    10    10    15
    15    70    10    30    30    30    30    10    70    15
    15    15    15    15    15    15    15    15    15    15
IGAIN =      1  IAG   =     30  IMG   =     45
IMX   =      4  IMY   =      6  ITBRK =      0
ITWDL =      1  MX    =      4  MY    =      6
NEMPT =     32  NHUMN =     79  NMACH =     88
NMIDL =     15  NSIDE =     30  NEXT2 =     10
NCORN =     70  NNX2C =     20  IFLIP =      1
IPHAS =      0  LCTL1 =      1  LCTL3 =      1
LCTL4 =      3  LEVEL =      1  MAXRE =      2
IDEPT =      0
JMX   =      6     7     0
JMY   =      4     7     0
JIMG  =     45     0     0
JIMX  =      4     7     0
JIMY  =      6     3     0
JIAG  =     30    30     0
JGAIN =      2     2     0
JLCTL =      1     2     0
KIAG  =     30     0     0
STOP

VDOS DEV 1.61
? "CHESS.ALG" "CHESS.REL" ALGOL
LOADING ALGOL AND OPENING FILES
LOADING..LOADING..............RUNNING ALGOL...
AT HALT, SELECT P, SET TO 77000, STORE, RUN
PRESS ANY KEY TO START...
PAGE  001


001 02000 HPAL,L,B,"CHESS"
002 02000 BEGIN
003 02003 COMMENT MINI-TECH - WRITTEN BY JIM GILLOGLY, JUNE 1971,
004 02003 MODIFIED, ANNOTATED AND ADAPTED FOR CLASS USE BY RON OHLANDER,
005 02003 OCT 1971.  MODIFIED AND REANNOTATED BY JIM GILLOGLY, FEB L972.
006 02003 TRANSLATED TO SAIL BY PAUL DANTZIG, MAY 1973.
007 02003 CHESS POSITIONAL ANALYSIS ADDED BY KEN POCEK, JUNE 1973.
008 02003 ADAPTED TO HP ALGOL BY ED DOUST AND KEN POCEK, SEPT, 1973
009 02003 &
010 02003 &
011 02003      THIS PROGRAM WILL PLAY CHESS BY GENERATING A "BEST MOVE"
012 02003 FROM A MINIMAX GAME TREE.  THE METHOD USED IS BRUTE FORCE.
013 02003 ALTHOUGH ALPHA-BETA PRUNING IS UTILIZED, NO HEURISTICS ARE
014 02003 EMBEDDED IN THE PROGRAM.
015 02003 &
016 02003      EVERY MOVE IS REPRESENTED BY A 32-BIT COMPUTER WORD. CERTAIN
017 02003 BITS OF THE WORD DENOTE GAME SITUATIONS AND WILL REMAIN CONSTANT
018 02003 CASTLING RIGHTS. IN GENERAL THE FIELDS OF A MOVE WORD HAVE THE
019 02003 FOR EACH MOVE UNLESS CHANGED.  FOR EXAMPLE, BITS 20-23 DENOTE
020 02003 SIGNIGICANCE SPECIFIED BELOW.
021 02003 &
022 02003 &
023 02003           <0,7> - BOARD POSITION MOVED TO,
024 02003           <7,7> - BOARD POSITION MOVED FROM,
025 02003           <14,2> - PROMOTION PIECE VALUE,
026 02003           <16,1> - EN PASSANT CAPTURE,
027 02003           <17,1> - NORMAL PIECE CAPTURE,
028 02003           <18,1> - OCCURRENCE OF A PROMOTION,
029 02003           <19,1> - OCCURRENCE OF CASTLING,
030 02003           <20,2> - BLACK CASTLING RIGHTS,
031 02003           <22,2> - WHITE CASTLING RIGHTS,
032 02003           <24,3> - PIECE CAPTURED,
033 02003           <27,1> - DENOTES PLAYER WHO MADE THE MOVE, (1=W,0=B)
034 02003           <28,1> - THIS IS THE FIRST MOVE OF A GROUP
035 02003                    (TRUE OF FALSE),
036 02003           <31,1> - SUCCESSORS OF THIS MOVE HAVE BEEN CONSIDERED.
037 02003 &
038 02003 &
039 02003      THE BOARD REPRESENTATION IS STORED IN A 120-WORD ARRAY. WORDS
040 02003 21 - 28, 31 - 38, ..., 91 - 98 REPRESENT THE 64 SQUARES OF THE
041 02003 CHESS BOARD.  THE REMAINDER OF THE ARRAY FORMS A BUFFER AROUND
042 02003 THE BOARD THAT INDICATES THAT  A MOVE HAS TAKEN A PIECE OFF THE
043 02003 GAME BOARD. THE WORDS OF THE ARRAY WILL HOLD AN INTEGER FROM
044 02003 -6 TO 7. THE NUMBERS HAVE THE FOLLOWING SIGNIFICANCE.
045 02003 &
046 02003 &
047 02003           0 - MEANS THE SQUARE IS EMPTY,
048 02003     -1 OR 1 - MEANS THE SQUARE IS OCCUPIED BY A PAWN,
049 02003     -2 OR 2 - MEANS THE SQUARE IS OCCUPIED BY A KNIGHT,
050 02003     -3 OR 3 - MEANS THE SQUARE IS OCCUPIED BY A BISHOP,
051 02003     -4 OR 4 - MEANS THE SQUARE IS OCCUPIED BY A ROOK,
052 02003     -5 OR 5 - MEANS THE SQUARE IS OCCUPIED BY A QUEEN,
053 02003     -6 OR 6 - MEANS THE SQUARE IS OCCUPIED BY A KING,
054 02003           7 - MEANS THE SQUARE IS OFF THE BOARD.
055 02003 &
056 02003 &
057 02003 &
PAGE  002


058 02003 &
059 02003      IF A PIECE IS INDICATED, POSITIVE DENOTES WHITE,
060 02003 NEGATIVE BLACK. THE VECTOR SHOULD BE VISUALIZED AS SHOWN.
061 02003 &
062 02003 &
063 02003      110  7   7   7   7   7   7   7   7   7   7
064 02003 &
065 02003      100  7   7   7   7   7   7   7   7   7   7
066 02003             ---------------------------------
067 02003       90  7 !-4 !-2 !-3 !-5 !-6 !-3 !-2 !-4 ! 7
068 02003             ---------------------------------
069 02003       80  7 !-1 !-1 !-1 !-1 !-1 !-1 !-1 !-1 ! 7
070 02003             ---------------------------------
071 02003       70  7 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 7
072 02003             ---------------------------------
073 02003       60  7 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 7
074 02003             ---------------------------------
075 02003       50  7 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 7
076 02003             ---------------------------------
077 02003       40  7 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 0 ! 7
078 02003             ---------------------------------
079 02003       30  7 ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 1 ! 7
080 02003             ---------------------------------
081 02003       20  7 ! 4 ! 2 ! 3 ! 5 ! 6 ! 3 ! 2 ! 4 ! 7
082 02003             ---------------------------------
083 02003       10  7   7   7   7   7   7   7   7   7   7
084 02003 &
085 02003        0  7   7   7   7   7   7   7   7   7   7
086 02003 &
087 02003           0   1   2   3   4   5   6   7   8   9   ;
088 02003 &
089 02003 &
090 02003 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
091 02003 &
092 02003 &    TO ALTER THE PROGRAM CONFIGURATION FOR VARIOUS ENVIRONMENTS
093 02003 &    SUCH AS BCS, DOS-M ETC, CHANGE THE NEXT RECORD.
094 02003    EQUATE TTY:=1, KBD:=1, LISTU:=6;
095 02003    EQUATE TREESIZE:=250;  &MAXIMUM SIZE OF TREE ARRAY
096 02003   EQUATE MDEPTH:=3; & MAXIMUM NUMBER OF SEARCH LEVELS
097 02003 &
098 02003 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
099 02003 &
100 02003   INTEGER WHITEPOINTS, BLACKPOINTS, I, J, BW, T, F, S, DEPTH,
101 02003     MATERIAL, TREEPTR, TRACPOS, MOVE, TOMOD10, FROMOD10, AT,
102 02003     WILL, PIECE, SQUARE, HERE, THERE;
103 02003   INTEGER YOUCHECK, MYCHECK;
104 02003   INTEGER ARRAY PIECEVAL[1:6], AB[-1:9], OUTS[1:20], A[1:10],
105 02063     POSITIONVAL[0:100], TREE[0:TREESIZE,1:2];
106 03216   INTEGER ARRAY B[0:119]:=
107 03216     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7,
108 03242     7, 4, 2, 3, 5, 6, 3, 2, 4, 7, 7, 1, 1, 1, 1, 1, 1, 1, 1, 7,
109 03266     7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7,
110 03312     7, 0, 0, 0, 0, 0, 0, 0, 0, 7, 7, 0, 0, 0, 0, 0, 0, 0, 0, 7,
111 03336     7,-1,-1,-1,-1,-1,-1,-1,-1, 7, 7,-4,-2,-3,-5,-6,-3,-2,-4, 7,
112 03362     7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7;
113 03406   INTEGER ARRAY CC[0:98]:=
114 03406     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
PAGE  003


115 03432     0, 0, 1, 2, 3, 3, 2, 1, 0, 0, 0, 1, 3, 4, 5, 5, 4, 3, 1, 0,
116 03456     0, 2, 4, 6, 7, 7, 6, 4, 2, 0, 0, 3, 5, 7, 8, 8, 7, 5, 3, 0,
117 03502     0, 3, 5, 7, 8, 8, 7, 5, 3, 0, 0, 2, 4, 6, 7, 7, 6, 4, 2, 0,
118 03526     0, 1, 3, 4, 5, 5, 4, 3, 1, 0, 0, 0, 1, 2, 3, 3, 2, 1, 0;
119 03551   INTEGER ARRAY PCVAL[0:12]:=
120 03551     -15000,-900,-500,-330,-330,-100,0,100,330,330,500,900,15000;
121 03566   INTEGER ARRAY LM, MV, LMASK, PVAR, NEXT[1:2];
122 03600   INTEGER ARRAY PCS[0:6]:="  ","P ","N ","B ","R ","Q ","K ";
123 03607   LABEL NMOVE, DONE;
124 03611   PROCEDURE BLANK(A); INTEGER ARRAY A; CODE;
125 03611   PROCEDURE IZERO(A); INTEGER ARRAY A; CODE;
126 03611   PROCEDURE CBITF(A,B,C); VALUE B,C; INTEGER A, B, C; CODE;
127 03611   PROCEDURE SBITF(A,B,C,D); VALUE B, C, D;
128 03612     INTEGER A, B, C, D; CODE;
129 03611   PROCEDURE SAVE(A,B,C,D); INTEGER A, B, C, D; CODE;
130 03611   PROCEDURE RETRO(A,B,C,D,E); INTEGER A, B, C, D, E; CODE;
131 03611   PROCEDURE ECUTE(A,B,C,D,E,F,G,H); INTEGER E, F, G, H;
132 03612     INTEGER ARRAY A, B, C, D; CODE;
133 03611   FORMAT
134 03611     SORTM(" SORT MOVES"/" MOVE"6X"FROM"8X"TO"5X"VALUE"/),
135 03641     FSEEK(XI4,3(6XI4)),
136 03650     CHECKMATE(" **CHECKMATE**"),
137 03661   DASH(6X,"---------------------------------"),
138 03705     CHEK(" CHECK"),
139 03712     CONCEDE(" DO YOU CONCEDE? _"),
140 03725   MIDFORM(/" MIDGAME"//31X"CENTER"3X"MOBI"3X"KING"4X"MID"/
141 03755    " MOVE"2X"PIECE"4X"FROM"4X"TO"2X"CONT'L"3X"LITY"2X"CHASE"
142 04012       3X"BONUS"3X"TOTAL"//),
143 04025     SERCH(A2,3I4,2(2XK6)),
144 04035     LIN2(XI3,5A2,2(2XI4)5(3XI5)),
145 04051     OPENA(" OPENING ANAL."/" MOVE"2X"PIECE"4X"FROM"4X"TO"2X
146 04102       "CONT'L"3X"BONUS"//),
147 04114     SLECT("CHOICE: (B=1, W=-1) _"),
148 04131     HEADER(/"HP CHESS VERSION A  10/26/73"//"DUMPS AVAILABLE:"/
149 04163           5X,"SW0 - MOVE LIST"/5X,"SW1 - BOTTOM NODE DUMP"/
150 04214           5X,"SW2 - FULL DUMP"///),
151 04230     YTURN("YOUR TURN: FROM SQUARE? _"),
152 04247     SEEIT(5(2XI5)6(2XK6)),
153 04257     ILL("ILLEGAL! TRY AGAIN"),
154 04272     F1(/"PIECE VALUES:"/"1=P, 2=N, 3=B, 4=R, 5=Q, 6=K"/
155 04322       "POSITIVE=WHITE, NEGATIVE=BLACK"/"TYPE SQUARE=0 TO END"),
156 04357     SQ("SQUARE=? _"), PC("PIECE=? _"),
157 04375     YTURN2("TO SQUARE? _");
158 04405   OUTPUT BOARD(FOR J:=1 TO 20 DO[OUTS[J]]);
159 04431 &
160 04431 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
161 04431 &
162 04431   PROCEDURE TRY;
163 04432   BEGIN FORMAT F1(4I5,XI6,6(2XK6));
164 04446     OUTPUT L1(F,BW,DEPTH,TREEPTR,MATERIAL,TREE[TREEPTR,2],
165 04467       TREE[TREEPTR,1],NEXT[2],NEXT[1],LM[2],LM[1]);
166 04522     WRITE(LISTU,F1,L1)
167 04530   END OF TRY;
168 04532 &
169 04532 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
170 04532 &
171 04532   PROCEDURE BUMP;
PAGE  004


172 04533   BEGIN TREEPTR:=TREEPTR+1; IF TREEPTR>TREESIZE THEN
173 04544     BEGIN WRITE(TTY,FSEEK,TREEPTR); GO DONE
174 04555   END END OF BUMP;
175 04556 &
176 04556 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
177 04556 &
178 04556   PROCEDURE TYPEB;
179 04557   BEGIN FOR I:=90 STEP -10 UNTIL 20 DO
180 04577     BEGIN WRITE(LISTU,DASH); BLANK(OUTS);
181 04610       OUTS[2]:=ROTATE((I\10) OR @60) OR @60;
182 04627       OUTS[20]:="! ";
183 04636       FOR J:=1 TO 8 DO
184 04647       BEGIN OUTS[2*(J+1)]:=IF B[I+J]<0 THEN "!*" ELSE "! ";
185 04676         OUTS[2*(J+1)+1]:=PCS[ABS(B[I+J])]
186 04723       END; WRITE(LISTU,#(20A2),BOARD)
187 04746     END; WRITE(LISTU,DASH);
188 04761     WRITE(LISTU,#("0"4X,8(3XI1)//),FOR J:=1 TO 8 DO[J])
189 05017   END OF TYPEB;
190 05021 &
191 05021 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
192 05021 &
193 05021   PROCEDURE PUSHM;
194 05022   BEGIN LABEL ENTR, RTRUN; INTEGER FGTRO, FR, FLG;
195 05027 &
196 05027 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
197 05027 &
198 05027   BOOLEAN PROCEDURE CHECK(I); INTEGER I;
199 05031   BEGIN LABEL EXITFOR; INTEGER TMP,TBACK;
200 05036     INTEGER ARRAY TLMASK[1:2];
201 05040     TMP:=CBITF(LM[1],20,4); SBITF(LM[1],20,4,15);
202 05066     TLMASK[1]:=LMASK[1]; TLMASK[2]:=LMASK[2];
203 05112     TBACK:=TREEPTR; F:=-F; FLG:=TRUE; GO ENTR;
204 05122 RTRUN: FLG:=CHECK:=FALSE;
205 05125     FOR J:=TBACK+1 TO TREEPTR DO
206 05137     IF CBITF(TREE[J,1],0,7)=I THEN
207 05157     BEGIN CHECK:=TRUE; GO EXITFOR END;
208 05166 EXITFOR: F:=-F; TREEPTR:=TBACK; LMASK[1]:=TLMASK[1];
209 05205     LMASK[2]:=TLMASK[2]; SBITF(LM[1],20,4,TMP)
210 05232   END OF CHECK;
211 05234 &
212 05234 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
213 05234 &
214 05234   PROCEDURE CAS(A1,A2,A3,A4,A5,A6);
215 05235   VALUE A1, A2, A3, A4, A5, A6;
216 05235   INTEGER A1, A2, A3, A4, A5, A6;
217 05235   BEGIN INTEGER I; LABEL EXITCAS;
218 05250     FOR I:=A3 TO A4 DO IF B[I]#0 THEN GO EXITCAS;
219 05274     FOR I:=A1 TO A2 DO IF CHECK(I) THEN GO EXITCAS; BUMP;
220 05321     TREE[TREEPTR,1]:=LMASK[1] OR A5*2^7 OR A6;
221 05344     TREE[TREEPTR,2]:=LMASK[2] OR @10;
222 05360 EXITCAS: END OF CAS;
223 05361 &
224 05361 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
225 05361 &
226 05361   PROCEDURE CASTL(A1,B1,A2,B2,A3,B3,A4);
227 05362   VALUE A1, B1, A2, B2, A3, B3, A4;
228 05362   INTEGER A1, B1, A2, B2, A3, B3, A4;
PAGE  005


229 05362   BEGIN IF CBITF(LM[1],A1,B1)<3 THEN
230 05411     BEGIN IF CBITF(LM[1],A2,B2)=0 THEN
231 05425       CAS(A4,A4+2,A4+1,A4+2,A4,A4+2);
232 05451       IF CBITF(LM[1],A3,B3)=0 THEN
233 05465       CAS(A4-2,A4,A4-3,A4-1,A4,A4-2)
234 05511   END END OF CASTL;
235 05512 &
236 05512 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
237 05512 &
238 05512 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
239 05512   COMMENT IF POSSIBLE MAKE KING OR KNIGHT MOVE;
240 05512   &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
241 05512   &
242 05512     PROCEDURE KINGN(A1,A2,A3,A4,A5,A6,A7,A8);
243 05513     VALUE A1, A2, A3, A4, A5, A6, A7, A8;
244 05513     INTEGER A1,A2,A3,A4,A5,A6,A7,A8;
245 05513     FOR I:=8 STEP -1 UNTIL 1 DO
246 05544     BEGIN LABEL EXITKN; INTEGER DST;
247 05546       CASE I BEGIN
248 05551         DST:=FR+A1;  DST:=FR+A2;  DST:=FR+A3;  DST:=FR+A4;
249 05571         DST:=FR+A5;  DST:=FR+A6;  DST:=FR+A7;  DST:=FR+A8
250 05605       END; T:=B[DST]; IF T=7 THEN GO EXITKN;
251 05635       T:=IF FGTRO=1 THEN -T ELSE T;
252 05646       IF T<0 THEN GO EXITKN; BUMP;
253 05653 &
254 05653 &  IF T=0 THEN REGULAR MOVE ELSE A CAPTURE
255 05653 &
256 05653       TREE[TREEPTR,1]:=LMASK[1] OR DST;
257 05667       TREE[TREEPTR,2]:=LMASK[2] OR
258 05701       (IF T=0 THEN 0 ELSE (2 OR T*2^8));
259 05717 EXITKN: END OF KINGN;
260 05724   &
261 05724   &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
262 05724 &  IF POSSIBLE MAKE THE BISHOP, ROOK OR QUEEN MOVE;
263 05724 &
264 05724     PROCEDURE BPRKQN(NUM,A1,A2,A3,A4,A5,A6,A7,A8);
265 05725     VALUE NUM, A1, A2, A3, A4, A5, A6, A7, A8;
266 05725     INTEGER NUM, A1, A2, A3, A4, A5, A6, A7, A8;
267 05725     FOR I:=NUM STEP -1 UNTIL 0 DO
268 05757     BEGIN INTEGER DST; LABEL EXITBRQ;
269 05761       CASE I+1 BEGIN
270 05765         S:=A1;  S:=A2;  S:=A3;  S:=A4;
271 06001         S:=A5;  S:=A6;  S:=A7;  S:=A8
272 06012       END; DST:=FR;
273 06032       WHILE TRUE DO BEGIN
274 06035         DST:=DST+S; T:=B[DST]; IF T=7 THEN GO EXITBRQ;
275 06051         T:=IF FGTRO=1 THEN -T ELSE T;
276 06062         IF T<0 THEN GO EXITBRQ;
277 06065         BUMP; TREE[TREEPTR,2]:=LMASK[2];
278 06102         TREE[TREEPTR,1]:=LMASK[1] OR DST;
279 06116         IF T#0 THEN BEGIN TREE[TREEPTR,2]:=
280 06127           LMASK[2] OR @2 OR T*2^8;
281 06144           GO EXITBRQ
282 06145       END END;
283 06146 EXITBRQ: END OF BPRKQN;
284 06153   &
285 06153   &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
PAGE  006


286 06153   &
287 06153     PROCEDURE PAWNC(D); VALUE D; INTEGER D;
288 06154     BEGIN INTEGER T2; LABEL EXITPAWN;
289 06161       T2:=B[D]; IF T2=7 THEN GO EXITPAWN;
290 06172       T2:=IF FGTRO=1 THEN -T2 ELSE T2;
291 06203       IF T2>0 THEN
292 06206       BEGIN BUMP; TREE[TREEPTR,1]:=LMASK[1] OR D;
293 06224         TREE[TREEPTR,2]:=LMASK[2] OR @2 OR T2*2^8
294 06237       END ELSE
295 06250       IF (B[D-T]=-F) AND (D-T=CBITF(LM[1],0,7)) AND (D+T=
296 06320         CBITF(LM[1],7,7)) THEN
297 06343       BEGIN BUMP; TREE[TREEPTR,1]:=LMASK[1] OR D;
298 06361         TREE[TREEPTR,2]:=LMASK[2] OR @403
299 06373       END;
300 06375 EXITPAWN: END OF PAWNC;
301 06376 &
302 06376 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
303 06376 &
304 06376   PROCEDURE PROMO(TB,PTR); INTEGER TB,PTR;
305 06377   BEGIN INTEGER I,J;
306 06403   FOR I:=TB+1 TO PTR DO
307 06415   BEGIN TREE[I,2]:=TREE[I,2] OR 4;
308 06432     FOR J:=1 TO 3 DO
309 06443     BEGIN PTR:=PTR+1; TREE[PTR,2]:=TREE[I,2];
310 06462       CASE J BEGIN
311 06465         TREE[PTR,1]:=TREE[I,1] OR @40000;
312 06503         TREE[PTR,1]:=TREE[I,1] OR @100000;
313 06521         TREE[PTR,1]:=TREE[I,1] OR @140000
314 06534     END END END
315 06555   END OF PROMO;
316 06556 &
317 06556 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
318 06556 &  ACTUAL BEGINNING OF PUSHMOVE
319 06556 &
320 06556     FLG:=FALSE;
321 06560 ENTR: FGTRO:=IF F>0 THEN 1 ELSE 0;
322 06570     LMASK[2]:=LM[2] AND @360; LMASK[1]:=0;
323 06612     SBITF(LMASK[1],27,1,FGTRO);
324 06625 &
325 06625 &  CONSIDER ALL POSSIBLE SQUARES;
326 06625 &
327 06625     FOR SQUARE:=21 TO 98 DO
328 06636     BEGIN INTEGER PC; LABEL NEXTSQUARE;
329 06640       FR:=SQUARE; PC:=B[SQUARE];
330 06647       IF PC=0 OR PC=7 THEN GO NEXTSQUARE;
331 06662       PC:=IF FGTRO>0 THEN PC ELSE -PC;
332 06673       IF PC<0 THEN GO NEXTSQUARE;
333 06676       LMASK[1]:=(LMASK[1] AND @140177) OR FR*2^7;
334 06720 &
335 06720 &    CONSIDER POSSIBLE MOVES;
336 06720 &
337 06720       CASE PC BEGIN
338 06723         BEGIN & PAWN TO MOVE;
339 06723           INTEGER UP1,TB;
340 06723           T:=IF FGTRO>0 THEN 10 ELSE -10;
341 06733           UP1:=FR+T; TB:=TREEPTR;
342 06740 &    CONSIDER PAWN CAPTURES;
PAGE  007


343 06740           PAWNC(UP1-1); PAWNC(UP1+1); IF B[UP1]=0 THEN
344 06762           BEGIN BUMP; TREE[TREEPTR,1]:=LMASK[1] OR UP1;
345 07000             TREE[TREEPTR,2]:=LMASK[2];
346 07013             IF FGTRO>0 THEN
347 07017             BEGIN
348 07017               IF (FR<39) AND (B[FR+20]=0) THEN
349 07036               BEGIN BUMP;
350 07040                 TREE[TREEPTR,1]:=(LMASK[1] OR (FR+20));
351 07057                 TREE[TREEPTR,2]:=LMASK[2]
352 07065               END END ELSE
353 07073               IF FR>80 AND B[FR-20]=0 THEN
354 07114               BEGIN BUMP;
355 07116                 TREE[TREEPTR,1]:=LMASK[1] OR FR-20;
356 07135                 TREE[TREEPTR,2]:=LMASK[2]
357 07143             END END;
358 07150 &
359 07150 &    PROMOTE A PAWN
360 07150 &
361 07150           IF UP1>90 OR UP1<30 THEN PROMO(TB,TREEPTR)
362 07166           END OF PAWN SECTION;
363 07167           KINGN(-12,-21,-19,-8,12,21,19,8); & KNIGHT MOVES
364 07202           BPRKQN(3,-11,-9,11,9,0,0,0,0); & BISHOP MOVES
365 07216           BPRKQN(3,-10,-1,10,1,0,0,0,0); & ROOK MOVES
366 07232           BPRKQN(7,-10,-1,10,1,-11,-9,11,9); & QUEEN MOVES
367 07246           KINGN(-10,-1,10,1,-11,-9,11,9); & KING MOVES
368 07261         END;
369 07274 NEXTSQUARE: END;
370 07300     IF FLG THEN GO RTRUN;
371 07304     LMASK[1]:=LMASK[1] AND @140177;
372 07317     IF FGTRO>0 THEN CASTL(22,2,22,1,23,1,25) ELSE
373 07335     CASTL(20,2,20,1,21,1,95);
374 07346     TREE[TREEPTR,2]:=TREE[TREEPTR,2] OR @10000
375 07361   END OF PUSHM;
376 07364 &
377 07364 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
378 07364 &
379 07364   PROCEDURE READM;
380 07365   BEGIN LABEL EXITWHILE, JUMPOUT, MOVERR;
381 07373     INTEGER ORG, DST, C5;
382 07373     TREEPTR:=DEPTH:=0; PUSHM;
383 07400 MOVERR:
384 07400     MV[1]:=MV[2]:=0; TYPEB;
385 07417   C5:=0;
386 07421     WRITE(TTY,YTURN); READ(KBD,*,ORG); IF ORG=0 THEN GO DONE;
387 07442     WRITE(TTY,YTURN2); READ(KBD,*,DST);
388 07457     IF (ABS(B[ORG])=1) AND ((DST>90) OR (DST<29)) THEN
389 07504     BEGIN
390 07504       WRITE(TTY,#("PAWN =? _")); READ(KBD,*,C5);
391 07531       C5:=C5-2;
392 07534     END; SBITF(MV[1],0,7,DST); SBITF(MV[1],7,7,ORG);
393 07562     SBITF(MV[1],14,2,C5);
394 07575     FOR I:=0 TO TREEPTR DO IF MV[1]=TREE[I,1] THEN
395 07625     BEGIN MV[1]:=TREE[I,1]; MV[2]:=TREE[I,2]; GO EXITWHILE
396 07654     END; WRITE(TTY,ILL); GO MOVERR;
397 07667 EXITWHILE: TREEPTR:=0; SAVE(LM[1],B[21],MATERIAL,DEPTH);
398 07711     ECUTE(MV,LM,B,PCVAL,DEPTH,F,BW,MATERIAL); PUSHM;
399 07725     WRITE(LISTU,#( " YOU MOVED FROM ",I2," TO ",I2/),ORG,DST);
PAGE  008


400 07761     FOR I:=0 TO TREEPTR DO
401 07772     IF B[CBITF(TREE[I,1],0,7)]=-6*BW THEN
402 10023     BEGIN WRITE(TTY,CHEK); WRITE(TTY,CONCEDE);
403 10037       READ(KBD,#(A1),HERE); IF HERE=" Y" THEN GO DONE;
404 10056     END; FOR I:=0 TO TREEPTR DO
405 10073     IF B[CBITF(TREE[I,1],0,7)]=-6*BW THEN
406 10124     BEGIN WRITE(LISTU,CHEK); WRITE(TTY,CONCEDE);
407 10140       READ(KBD,*,HERE); IF HERE=1 THEN GO DONE;
408 10154       GO JUMPOUT
409 10155     END; YOUCHECK:=0;
410 10163 JUMPOUT: IF YOUCHECK=1 THEN
411 10167     BEGIN TREEPTR:=0; RETRO(LM[1],B[21],F,MATERIAL,DEPTH);
412 10212       GO MOVERR
413 10213     END; MYCHECK:=TREEPTR:=0; F:=-F; PUSHM;
414 10223     FOR I:=0 TO TREEPTR DO IF ABS(B[CBITF(TREE[I,1],0,7)])=6
415 10256     THEN BEGIN WRITE(LISTU,CHEK); MYCHECK:=1 END;
416 10275     F:=-F
417 10275   END OF READM;
418 10301 &
419 10301 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
420 10301 &
421 10301 COMMENT
422 10301 &
423 10301     THE POSITIONAL ANALYSIS ROUTINES THAT FOLLOW CONTAIN
424 10301 ALL OF THE CHESS SPECIFIC HEURISTICS USED IN THIS ALGOL VERSION
425 10301 OF GILLOGLY'S MINI-TECH PROGRAM. THE NEED FOR THESE HEURISTICS
426 10301 IS TWO-FOLD. FIRST IT REDUCES THE TIME NECESSARY FOR THE BRUTE
427 10301 FORCE GAME TREE SEARCH PORTION OF THE PROGRAM (THE TACTICAL
428 10301 ANALYSIS PHASE) TO FIND A MOVE. IT DOES THIS BY PRE-SORTING
429 10301 THE MOVES AT THE TOP LEVEL (DEPTH=1) SO THAT THE MOVE WHICH HAS
430 10301 THE BEST SUPERFICIAL POSITIONAL SCORE IS CONSIDERED FIRST.
431 10301 SECONDLY, IT ALLOWS MINI-TECH TO GET THROUGH THE OPENING AND
432 10301 MIDGAMES WITHOUT HAVING A HOPELESS POSITIONAL DISADVANTAGE DUE
433 10301 TO ITS LIMITED TREE SEARCH CAPABILITY (ONLY 3 PLIES DEEP).
434 10301 &
435 10301 &
436 10301                   ********    THE OPENING    *****
437 10301 &
438 10301 &
439 10301   THE OPENING IS DEFINED TO BE THE FIRST EIGHT MOVES. THE MOST
440 10301 IMPORTANT HEURISTIC IN THE OPENING EVALUATION IS OCCUPATION OF
441 10301 THE CENTER (SEE PROCEDURE CENCON). EACH SQUARE ON THE BOARD IS
442 10301 WEIGHTED WITH A DESIRABILITY VALUE RANGING FROM 0 POINTS FOR THE
443 10301 CORNERS TO 8 POINTS FOR THE CENTER (SEE ARRAY CC). EACH MOVE
444 10301 REPRESENTS A NET GAIN OR LOSS OF CENTRALITY. FOR EXAMPLE, N-KB3
445 10301 WOULD YIELD A GAIN OF 5 POINTS IN CENTRALITY. THIS IS MULTIPLIED
446 10301 BY THE PRIORITY FACTOR FOR THE PIECE TO MOVE: P=1, N=4, B=3, R=2,
447 10301 Q=1 AND K=-1. THUS N-KB3 WOULD HAVE A FINAL SCORE OF 20 POINTS
448 10301 FOR CENTRALITY. NOTICE THAT THE KING IS ENCOURAGED TO MOVE AWAY
449 10301 FROM THE CENTER IN THE OPENING, SINCE ITS CENTER-TROPISM FACTOR
450 10301 IS NEGATIVE. THIS HEURISTIC ALONE DICTATES A VERY REASONABLE
451 10301 OPENING WITH RAPID DEVELOPMENT.
452 10301 &
453 10301   EACH MOVE IS GIVEN A FINAL POSITIONAL SCORE OF THE CENTRALITY
454 10301 TERM PLUS THE VALUE OF EACH OF THE FOLLOWING HEURISTICS WHICH
455 10301 APPLIES TO IT. SEE PROCEDURE OPENB.
456 10301 &
PAGE  009


457 10301      PAWN FROM K2 TO K4:       30 POINTS
458 10301      PAWN FROM K3 TO K4:        2 POINTS
459 10301      PAWN FROM Q2 TO Q4:       20 POINTS
460 10301      PAWN FROM Q3 TO Q4:        2 POINTS
461 10301      O - O                     30 POINTS
462 10301      O - O - O                 10 POINTS
463 10301      N - R3                   -15 POINTS
464 10301      PIECE TO K3 OR Q3 BLOCKING A PAWN       -50
465 10301      PIECE MOVING FROM KING SIDE               2 POINTS
466 10301      PLAYING PETROFF DEFENCE                 -50 POINTS
467 10301      CAPTURE WITH PAWN TOWARD CENTER           5 POINTS
468 10301      CAPTURE WITH PAWN AWAY FROM CENTER       -5 POINTS
469 10301      PAWN CAPTURE LEADING TO MULTIPLE
470 10301           ISOLATED PAWNS                     -10 POINTS
471 10301      WING PAWN ADVANCE                       -10 POINTS
472 10301      CAPTURE UNSUPPORTED CENTER PAWN          50 POINTS
473 10301      CAPTURE SUPPORTED CENTER PAWN           -15 POINTS
474 10301 &
475 10301 &
476 10301                   ********    MIDDLE GAME    ********
477 10301 &
478 10301   THE MIDDLE GAME BEGINS WITH THE NINTH MOVE AND CONTINUES
479 10301 UNTIL ONE SIDE HAS LESS THAN 1950 POINTS WORTH OF MATERIAL.
480 10301 EXCLUDING THE KING (EACH SIDE HAS 4020 IN THE INITIAL POSITION),
481 10301 (SEE PROCEDURE MDGAME). THE CENTER CONTROL HEURISTIC IS STILL
482 10301 USED, BUT THE PRIORITY FACTORS ARE SLIGHTLY ALTERED: P=3, N=4,
483 10301 B=3, R=2, Q=1, AND K=1. SINCE MOST PIECES HAVE FOUND THEIR BEST
484 10301 SQUARES BY THE MIDDLE GAME, THIS FACTOR HAS LESS INGLUENCE THAN
485 10301 IN THE OPENING. EACH MOVE IS CREDITED WITH A MOBILITY TERM (SEE
486 10301 PROCEDURE MOBILE), WHICH IS THE NUMBER OF POTENTIALLY LEGAL MOVES
487 10301 AVAILABLE AFTER THE MOVE IS MADE. MOVEMENT OF A PIECE INTO THE
488 10301 OPPONENT'S KING FIELD IS REWARDED IN THE SAME WAY AS THE CENTER
489 10301 CONTROL HEURISTIC, AND THE NET GAIN IS AGAIN MULTIPLIED BY THE
490 10301 PRIORITY FOR THAT PIECE (SEE PROCEDURE KINCH). THIS HEURISTIC
491 10301 OCCASIONALLY RESULTS IN A KING-SIDE ATTACK.
492 10301 &
493 10301   THE PAWN HEURISTICS ARE THE SAME AS IN THE OPENING, EXCEPT
494 10301 THAT ADVANCES OF WING PAWNS GET -5 INSTEAD OF -10. CASTLING
495 10301 VALUES ARE THE SAME AS IN THE OPENING. IF TECH IS AHEAD IN
496 10301 MATERIAL,PIECE CAPTURES GET 10 POINTS MORE. MOVING A PIECE
497 10301 WHICH BLOCKS THE KBP OR QBP IS REWARDED WITH 5 POINTS.          ;
498 10301 &
499 10301 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
500 10301 &
501 10301   INTEGER PROCEDURE CENCON(I); INTEGER I;
502 10303   BEGIN INTEGER CNTRCOEFF, AT, WILLBE;
503 10306     AT:=CBITF(TREE[I,1],0,7); WILLBE:=CBITF(TREE[I,1],7,7);
504 10336     CNTRCOEFF:=CC[AT]-CC[WILLBE];
505 10352     CENCON:=CNTRCOEFF*PIECEVAL[ABS(B[WILLBE])]
506 10361   END OF CENCON;
507 10371 &
508 10371 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
509 10371 &
510 10371   PROCEDURE SORT;
511 10372   BEGIN INTEGER I, TEMP, FLAG; LABEL LOOP;
512 10376   OUTPUT SEEK(I,CBITF(TREE[I,1],7,7),CBITF(TREE[I,1],0,7));
513 10432 LOOP: FLAG:=FALSE; FOR I:=1 TO TREEPTR-1 DO
PAGE  010


514 10446     BEGIN IF POSITIONVAL[I]>POSITIONVAL[I+1] THEN
515 10467       BEGIN TEMP:=TREE[I,1]; TREE[I,1]:=TREE[I+1,1];
516 10514         TREE[I+1,1]:=TEMP; TEMP:=TREE[I,2];
517 10535         TREE[I,2]:=TREE[I+1,2]; TREE[I+1,2]:=TEMP;
518 10567         TEMP:=POSITIONVAL[I]; POSITIONVAL[I]:=POSITIONVAL[I+1];
519 10611         POSITIONVAL[I+1]:=TEMP; FLAG:=TRUE
520 10623     END END;
521 10631    IF FLAG THEN GO LOOP;  IF (KEYS AND 1)=1 THEN
522 10642     BEGIN WRITE(LISTU,SORTM); FOR I:=1 TO TREEPTR DO
523 10661       WRITE(LISTU,FSEEK,SEEK,POSITIONVAL[I])
524 10674   END END OF SORT;
525 10702 &
526 10702 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
527 10702 &
528 10702   BOOLEAN PROCEDURE MDGAME;
529 10704   BEGIN INTEGER I, J, PV;
530 10706     WHITEPOINTS:=BLACKPOINTS:=0; MDGAME:=FALSE;
531 10713     FOR I:=1 TO 8 DO FOR J:=20 STEP 10 UNTIL 90 DO
532 10742     BEGIN PV:=B[I+J];
533 10752       IF PV>0 THEN WHITEPOINTS:=WHITEPOINTS+PCVAL[PV+6];
534 10766       IF PV<0 THEN BLACKPOINTS:=BLACKPOINTS-PCVAL[PV+6]
535 10774     END; WHITEPOINTS:=WHITEPOINTS-15000;
536 11016     BLACKPOINTS:=BLACKPOINTS-15000;
537 11021     IF WHITEPOINTS OR BLACKPOINTS THEN
538 11025     BEGIN WRITE(TTY,CHECKMATE); GO DONE END;
539 11034     IF (WHITEPOINTS>1950) OR (BLACKPOINTS>1950) THEN
540 11050   MDGAME:=TRUE;  IF (KEYS AND 1)=1 THEN
541 11057     WRITE(LISTU,#(XI5" WHITEPOINTS VS"I5" BLACKPOINTS"),
542 11110       WHITEPOINTS,BLACKPOINTS)
543 11114   END OF MDGAME;
544 11117 &
545 11117 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
546 11117 &
547 11117   INTEGER PROCEDURE MOBILE(I); INTEGER I;
548 11121   BEGIN INTEGER TEMP; INTEGER ARRAY MV[1:2];
549 11127     MV[1]:=TREE[I,1]; MV[2]:=TREE[I,2]; TEMP:=TREEPTR;
550 11157     SAVE(LM[1],B[21],MATERIAL,DEPTH);
551 11177     ECUTE(MV,LM,B,PCVAL,DEPTH,F,BW,MATERIAL); PUSHM;
552 11213     MOBILE:=TREEPTR-TEMP; TREEPTR:=TEMP;
553 11221     RETRO(LM[1],B[21],F,MATERIAL,DEPTH)
554 11242   END OF MOBILE;
555 11244 &
556 11244 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
557 11244 &
558 11244   INTEGER PROCEDURE KINGCH(I); INTEGER I;
559 11246   BEGIN INTEGER ROW, COLUMN, TOROW, TOCOLUMN, OPPKING, J;
560 11251     LABEL EXITLOOP; FOR J:=21 TO 98 DO
561 11264     IF B[J]=-F*6 THEN OPPKING:=J;
562 11310     ROW:=OPPKING\10; COLUMN:=OPPKING MOD 10;
563 11327     KINGCH:=0; TOCOLUMN:=CBITF(TREE[I,1],0,7) MOD 10;
564 11353     TOROW:=CBITF(TREE[I,1],0,7)\10;
565 11374   &
566 11374   &    IF MOVE BRINGS PIECE 1 SQUARE AWAY, BONUS=10,
567 11374   &    2 AWAY, BONUS=8 AND 3 AWAY, BONUS=2
568 11374   &
569 11374     FOR J:=1 TO 3 DO
570 11405     BEGIN IF TOROW<ROW+J AND TOROW>ROW-J
PAGE  011


571 11414       AND((TOCOLUMN=COLUMN+J) OR (TOCOLUMN=COLUMN-J))
572 11446       THEN KINGCH:=(IF J=1 THEN 10 ELSE IF J=2 THEN 8 ELSE 2);
573 11467       IF ((TOROW=ROW+J) OR (TOROW=ROW-J)) AND
574 11510       ((TOCOLUMN<COLUMN+J+1) AND (TOCOLUMN>COLUMN-J-1))
575 11532       THEN KINGCH:=(IF J=1 THEN 10 ELSE IF J=2 THEN 8 ELSE 2);
576 11553       IF KINGCH>0 THEN GO EXITLOOP
577 11560     END; KINGCH:=0;
578 11566 EXITLOOP: KINGCH:=KINGCH*PIECEVAL[ABS(B[CBITF(TREE[I,1],7,7)])]
579 11611   END OF KINGCH;
580 11621 &
581 11621 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
582 11621 &
583 11621   INTEGER PROCEDURE OPENB(I); INTEGER I;
584 11623   BEGIN LABEL JUMPOUT, RETN; INTEGER J, TBTREEPTR;
585 11631     OPENB:=0; AT:=CBITF(TREE[I,1],0,7);
586 11647     WILL:=CBITF(TREE[I,1],7,7);
587 11663     TOMOD10:=AT MOD 10; FROMOD10:=WILL MOD 10;
588 11703     IF F=1 THEN
589 11707     BEGIN A[1]:=35; A[2]:=45; A[3]:=55; A[4]:=34; A[5]:=44;
590 11752       A[6]:=54; A[7]:=27; A[8]:=23; A[9]:=41; A[10]:=48
591 12013     END ELSE
592 12016     BEGIN A[1]:=85; A[2]:=75; A[3]:=65; A[4]:=84; A[5]:=74;
593 12061       A[6]:=64; A[7]:=97; A[8]:=93; A[9]:=71; A[10]:=78
594 12122     END; IF B[WILL]=F THEN
595 12135     BEGIN
596 12135       IF (WILL=A[1]) AND (AT=A[3]) THEN OPENB:=30;
597 12165       IF (WILL=A[2]) AND (AT=A[3]) THEN OPENB:=2;
598 12215       IF (WILL=A[4]) AND (AT=A[6]) THEN OPENB:=20;
599 12245       IF (WILL=A[5]) AND (AT=A[6]) THEN OPENB:=2;
600 12275       IF OPENB>0 THEN GO RETN
601 12302     END; IF CBITF(TREE[I,1],19,1)=1 THEN
602 12320     BEGIN IF AT=A[7] THEN OPENB:=30;
603 12333       IF AT=A[8] THEN OPENB:=10; GO RETN
604 12347     END; IF (B[WILL]=2*F) AND ((AT=A[9]) OR (AT=A[10])) THEN
605 12414     BEGIN OPENB:=-15; GO RETN END;
606 12417     IF ((B[A[4]]=F) AND (AT=A[5])) OR
607 12450     ((B[A[1]]=F) AND (AT=A[2])) THEN
608 12505     IF (NOT(B[WILL]=F)) THEN
609 12521     BEGIN OPENB:=-50; GO RETN END;
610 12524     IF TOMOD10>4 THEN OPENB:=OPENB+2;
611 12534     IF CBITF(TREE[I,1],16,2)>0 AND (B[AT]=-F) THEN
612 12571     BEGIN OPENB:=OPENB-5;
613 12574       IF ((FROMOD10<5) AND (TOMOD10>FROMOD10)) THEN
614 12607       OPENB:=OPENB+10;
615 12612       IF (FROMOD10>4) AND (TOMOD10<FROMOD10) THEN
616 12625       OPENB:=OPENB+10
617 12625     END;
618 12630     IF (CBITF(TREE[I,1],16,2)>0) AND (B[AT]=-F) THEN
619 12665     FOR J:=1 TO 9 DO
620 12676     IF B[10*J+TOMOD10]=F THEN OPENB:=OPENB-10;
621 12723     IF (B[WILL]=F) AND ((FROMOD10<4) OR (FROMOD10>5))
622 12745     THEN OPENB:=OPENB-10;
623 12753     IF ((CBITF(TREE[I,1],16,2)>0) AND (B[AT]=-F))
624 13006     AND ((TOMOD10=4) OR (TOMOD10=5)) THEN
625 13024     BEGIN TBTREEPTR:=TREEPTR; SAVE(LM[1],B[21],MATERIAL,DEPTH);
626 13046       MV[1]:=TREE[I,1]; MV[2]:=TREE[I,2];
627 13074       ECUTE(MV,LM,B,PCVAL,DEPTH,F,BW,MATERIAL); PUSHM;
PAGE  012


628 13110       FOR J:=TBTREEPTR+1 TO TREEPTR DO
629 13122       IF (CBITF(TREE[I,1],0,7)=AT) AND
630 13142       (CBITF(TREE[J,1],16,2)>0) THEN
631 13163       BEGIN OPENB:=OPENB-15; GO JUMPOUT END;
632 13173       OPENB:=OPENB+50;
633 13176 JUMPOUT: RETRO(LM[1],B[21],F,MATERIAL,DEPTH); TREEPTR:=TBTREEPTR
634 13217     END;
635 13221 RETN: END OF OPENB;
636 13223 &
637 13223 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
638 13223 &
639 13223   INTEGER PROCEDURE MDBON(I); INTEGER I;
640 13225   BEGIN INTEGER J;
641 13230     MDBON:=OPENB(I); WILL:=CBITF(TREE[I,1],7,7);
642 13250     FROMOD10:=WILL MOD 10; AT:=CBITF(TREE[I,1],0,7);
643 13273     TOMOD10:=AT MOD 10; A[3]:=0;
644 13311     IF F=1 THEN BEGIN
645 13315       A[1]:=36; A[2]:=46; A[4]:=33; A[5]:=43 END
646 13351     ELSE BEGIN
647 13352       A[1]:=86; A[2]:=76; A[4]:=83; A[5]:=73 END;
648 13406     IF (B[WILL]=F) AND ((FROMOD10<4) OR (FROMOD10>5))
649 13430     THEN MDBON:=MDBON+5;
650 13436     IF ((BW=1) AND (WHITEPOINTS>BLACKPOINTS)) OR
651 13451     ((BW=-1) AND (BLACKPOINTS>WHITEPOINTS)) THEN
652 13470     IF CBITF(TREE[I,1],16,2)>0 THEN MDBON:=MDBON+10;
653 13511     IF ((WILL=A[5]) AND (B[A[4]]=F)) OR
654 13542     ((WILL=A[2]) AND (B[A[1]]=F)) THEN MDBON:=MDBON+5
655 13577   END OF MDBON;
656 13604 &
657 13604 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
658 13604 &
659 13604   PROCEDURE POSIT;
660 13605   BEGIN INTEGER II, ORG, DST;
661 13607     OUTPUT DATA(II,FOR I:=1 TO 5 DO[OUTS[I]],ORG,DST,CENCON(II));
662 13646   &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
663 13646     PROCEDURE SETM;
664 13647     BEGIN BLANK(OUTS); ORG:=CBITF(TREE[II,1],7,7);
665 13670       DST:=CBITF(TREE[II,1],0,7); OUTS[3]:=PCS[ABS(B[ORG])]
666 13720     END OF SETM;
667 13726   &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
668 13726     IZERO(POSITIONVAL);
669 13731     TRACPOS:=KEYS AND 1;
670 13734     IF MOVE<6 THEN
671 13740     BEGIN PIECEVAL[1]:=1; PIECEVAL[2]:=4; PIECEVAL[3]:=3;
672 13765       PIECEVAL[4]:=2; PIECEVAL[5]:=1; PIECEVAL[6]:=-1;
673 14012       IF TRACPOS=1 THEN WRITE(LISTU,OPENA);
674 14024       FOR II:=1 TO TREEPTR DO
675 14035       BEGIN POSITIONVAL[II]:=CENCON(II)+OPENB(II);
676 14053         IF TRACPOS=1 THEN
677 14057         BEGIN SETM; WRITE(LISTU,LIN2,DATA,OPENB(II))
678 14073       END END; SORT
679 14102     END ELSE
680 14103     IF MDGAME THEN
681 14107     BEGIN PIECEVAL[1]:=3; PIECEVAL[2]:=4; PIECEVAL[3]:=3;
682 14134       PIECEVAL[4]:=2; PIECEVAL[5]:=1; PIECEVAL[6]:=1;
683 14161       IF TRACPOS=1 THEN WRITE(LISTU,MIDFORM);
684 14173       FOR II:=1 TO TREEPTR DO
PAGE  013


685 14204       BEGIN POSITIONVAL[II]:=CENCON(II)+MOBILE(II)+KINGCH(II)
686 14225         +MDBON(II);
687 14234       IF TRACPOS=1 THEN
688 14240       BEGIN SETM; WRITE(LISTU,LIN2,DATA,MOBILE(II),KINGCH(II),
689 14260         MDBON(II),POSITIONVAL[II])
690 14271     END END; SORT
691 14300     END; FOR I:=1 TO TREEPTR DO TREE[I,2]:=TREE[I,2] AND @167777;
692 14332     TREE[TREEPTR,2]:=TREE[TREEPTR,2]OR @10000
693 14345   END OF POSIT;
694 14350 &
695 14350 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
696 14350 &
697 14350   PROCEDURE GENMOV;
698 14351   BEGIN LABEL LOOP, EXITBLOCK; INTEGER I, J;
699 14356     OUTPUT DUMP2(I,DEPTH,MATERIAL,CBITF(TREE[I,1],7,7),
700 14401       CBITF(TREE[I,1],0,7),TREE[I,2],TREE[I,1],PVAR[2],PVAR[1],
701 14443       NEXT[2],NEXT[1]);
702 14456   &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
703 14456   PROCEDURE DUMPIT;
704 14457   BEGIN INTEGER IDEPTH; FORMAT LINER(5X"DEPTH="I1,2(2XI2));
705 14475     IDEPTH:=1;
706 14477     FOR I:=0 TO TREEPTR DO IF TREE[I,2]<0 THEN
707 14517     BEGIN WRITE(LISTU,LINER,IDEPTH,CBITF(TREE[I,1],7,7),
708 14542         CBITF(TREE[I,1],0,7)); IDEPTH:=IDEPTH+1
709 14557     END; WRITE(LISTU,LINER,DEPTH,CBITF(NEXT[1],7,7),
710 14610      CBITF(NEXT[1],0,7));
711 14624     WRITE(LISTU,#(9(2XI6)),FOR IDEPTH:=0 TO MDEPTH DO[AB[IDEPTH]])
712 14661   END;
713 14663 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
714 14663     PROCEDURE BAKUP1;
715 14664     BEGIN LABEL OUT; T:=AB[DEPTH];
716 14675       IF T>AB[DEPTH-1] THEN
717 14711       BEGIN COMMENT HAVE NEW PBV;
718 14711         IF T>=AB[DEPTH-2] THEN
719 14725         BEGIN COMMENT: CUT-OFF, STRIP PRUNED MOVES;
720 14725           IF DEPTH=1 THEN GO OUT;
721 14732           DO TREEPTR:=TREEPTR-1 UNTIL TREE[TREEPTR+1,2];
722 14746           RETRO(LM[1],B[21],F,MATERIAL,DEPTH)
723 14767         END ELSE
724 14770       BEGIN IF (KEYS AND 2)=2 THEN DUMPIT;
725 14777           AB[DEPTH-1]:=T; IF DEPTH=1 THEN
726 15015           BEGIN PVAR[1]:=NEXT[1]; PVAR[2]:=NEXT[2] END
727 15041       END END;
728 15041 OUT: END OF BAKUP1;
729 15042   &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
730 15042     PROCEDURE BAKUP2;
731 15043   BEGIN T:=AB[DEPTH];
732 15052       IF T<AB[DEPTH-1] THEN
733 15067       BEGIN IF T<=AB[DEPTH-2] THEN
734 15103         BEGIN DO TREEPTR:=TREEPTR-1 UNTIL TREE[TREEPTR+1,2];
735 15117           RETRO(LM[1],B[21],F,MATERIAL,DEPTH)
736 15140         END ELSE
737 15141             BEGIN IF (KEYS AND 2)=2 THEN DUMPIT; AB[DEPTH-1]:=T;
738 15162     END END END OF BAKUP2;
739 15163   &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
740 15163     MATERIAL:=0;
741 15165     TREEPTR:=DEPTH:=0; PUSHM; POSIT;
PAGE  014


742 15174   IF (KEYS AND 4)=4 THEN WRITE(LISTU,#("0 F"3X"BW"2X"DEPTH"3X"PTR"
743 15225       2X"MATERIAL"8X"TREE"8X"NEXT"10X"LM"/));
744 15251     AB[0]:=-30000; AB[-1]:=AB[1]:=30000;
745 15275 LOOP: NEXT[1]:=TREE[TREEPTR,1]; NEXT[2]:=TREE[TREEPTR,2];
746 15323     TREE[TREEPTR,2]:=NEXT[2] OR @100000;
747 15337     IF CBITF(NEXT[1],27,1)=(IF F>0 THEN 1 ELSE 0) THEN
748 15366     BEGIN & SAVE THE OLD BOARD AND EXECUTE NEW MOVE
749 15366       IF CBITF(NEXT[1],28,1)=1 THEN
750 15403       SAVE(LM[1],B[21],MATERIAL,DEPTH);
751 15423       ECUTE(NEXT,LM,B,PCVAL,DEPTH,F,BW,MATERIAL)
752 15435     END;
753 15435      IF (KEYS AND 4)=4 THEN TRY;
754 15444     IF NEXT[2]>=0 THEN
755 15452     BEGIN & DEPTH OF 3 AT MAXIMUM DEPTH
756 15452       IF DEPTH>=MDEPTH THEN AB[DEPTH]:=MATERIAL
757 15463       ELSE BEGIN & GET NEXT MOVES AND CARRY DOWN A/B VALUES
758 15466         PUSHM; AB[DEPTH]:=AB[DEPTH-2]; GO EXITBLOCK
759 15506     END END;
760 15506     TREEPTR:=TREEPTR-1;
761 15511   &    IF REQUIRED, BACKUP ALPHA OR BETA VALUE
762 15511     IF DEPTH MOD 2=1 THEN BAKUP1 ELSE BAKUP2;
763 15530     RETRO(LM[1],B[21],F,MATERIAL,DEPTH);
764 15551 EXITBLOCK:  IF (KEYS AND 4)=4 THEN TRY;
765 15560     IF TREEPTR>0 THEN GO LOOP;
766 15565     IF CBITF(PVAR[1],18,1)=1 THEN
767 15602     BEGIN I:=CBITF(PVAR[1],14,2); WRITE(TTY,#("PROMOTION:"I3),I)
768 15635     END; PVAR[2]:=PVAR[2] AND @77777;
769 15651     ECUTE(PVAR,LM,B,PCVAL,DEPTH,F,BW,MATERIAL); PUSHM;
770 15665     WRITE(LISTU,#(/" MY MOVE FROM "I2" TO "I2//),CBITF(PVAR[1],7,7),
771 15726          CBITF(PVAR[1],0,7));
772 15742     FOR I:=0 TO TREEPTR DO
773 15753     IF (ABS(B[CBITF(TREE[I,1],0,7)])=6 AND MYCHECK=1) THEN
774 16010     BEGIN WRITE(6,CHECKMATE); GO DONE END;
775 16023     MYCHECK:=YOUCHECK:=TREEPTR:=0; F:=-F; PUSHM;
776 16034     FOR I:=0 TO TREEPTR DO
777 16045     IF ABS(B[CBITF(TREE[I,1],0,7)])=6 THEN
778 16072     BEGIN WRITE(LISTU,CHEK); YOUCHECK:=1 END;
779 16106     F:=-F
780 16106   END OF GENMOV;
781 16112 &
782 16112 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
783 16112 &
784 16112   PROCEDURE SETBOARD;
785 16113   BEGIN LABEL LOOP,ITSOK, CONTINUE;
786 16121     FOR I:=20 STEP 10 UNTIL 90 DO FOR J:=1 TO 8 DO B[I+J]:=0;
787 16172     WRITE(TTY,F1);
788 16200 LOOP: WRITE(TTY,SQ); READ(KBD,*,SQUARE);
789 16215     IF SQUARE=0 THEN GO CONTINUE;
790 16221     FOR I:=20 STEP 10 UNTIL 90 DO FOR J:=1 TO 8 DO
791 16250     IF SQUARE=I+J THEN GO ITSOK;
792 16270     WRITE(TTY,ILL); GO LOOP;
793 16277 ITSOK: WRITE(TTY,PC); READ(KBD,*,PIECE);
794 16314     IF ABS(PIECE)>6 THEN
795 16323     BEGIN WRITE(TTY,ILL); GO LOOP END;
796 16332     B[SQUARE]:=PIECE; GO LOOP;
797 16342 CONTINUE: TYPEB; WRITE(TTY,#("BOARD OK? (YES=1) _"));
798 16367     READ(KBD,*,SQUARE); IF SQUARE#1 THEN GO LOOP;
PAGE  015


799 16403     WRITE(TTY,#("MOVE NO? _")); READ(KBD,*,MOVE);
800 16430     WRITE(TTY,#("0=FULL RIGHTS, 1=DISALLOW QUEENS SIDE,"/
801 16463       "2=DISALLOW KINGS SIDE, 3= DISALLOW ANY"/
802 16507       "CASTLING RIGHTS, WHITE? _")); READ(1,*,SQUARE);
803 16536     SBITF(LM[1],22,2,SQUARE);
804 16551     WRITE(TTY,#("CASTLING RIGHTS, BLACK? _")); READ(TTY,*,SQUARE);
805 16606     SBITF(LM[1],20,2,SQUARE);
806 16621     WRITE(TTY,#(/"WHITE'S MOVE=1, BLACK=-1 _")); READ(KBD,*,F)
807 16657   END OF SETBOARD;
808 16660 &
809 16660 &* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
810 16660 &
811 16660     WRITE(TTY,HEADER);
812 16666   WRITE(TTY,#("TYPE 1 FOR A NEW GAME, 0 FOR OLD _"));
813 16720   READ(KBD,*,I); WRITE(TTY,SLECT); READ(KBD,*,BW);
814 16744   LM[1]:=1; LM[2]:=MATERIAL:=MOVE:=0;
815 16764   YOUCHECK:=MYCHECK:=0;
816 16767   IF I=1 THEN F:=1 ELSE SETBOARD;
817 17000 NMOVE: IF F=1 THEN MOVE:=MOVE+1;
818 17007   IF F=1 THEN WRITE(LISTU,#("1"//" MOVE= ",I2/),MOVE);
819 17036   IF BW=F THEN GENMOV ELSE READM; GO NMOVE;
820 17051 DONE: END OF CHESS$

PROGRAM= 015052 BASE PAGE= 000464  ERRORS=000

CLOSING FILES...DONE
VDOS DEV 1.61
? "CHESS1.ASM" "CHESS.REL" ASMB
File exists. Overwrite? N WILL APPEND
PREPARING DOUBLED SOURCE FILE
Writing USB file --TEMP--.ASM
 WAIT...
Closing output buffer
LOADING EXTASMB AND OPENING FILES
LOADING..LOADING.........RUNNING EXTASMB...
AT HALT PRESS THE RUN SWITCH
AT NEXT HALT, SELECT P, SET TO 77000, STORE, RUN
PRESS ANY KEY TO START...
 PAGE 0001


0001                ASMB,R,L,B
**  NO ERRORS*
 PAGE 0002 #01


0001                ASMB,R,L,B
0002  00000               NAM ECUTE,7
0003                      ENT ECUTE
0004                      EXT .PRAM


0006*     THIS IS AN ALGOL CALLABLE PROCEDURE DESIGNED
0007*     TO PERFORM THE MOVE EXECUTION REQUIRED BY THE MINI-TECH
0008*     CHESS GAME.

0010*     CALLING SEQUENCE:
0011*     DEFINE AN EXTERNAL PROCEDURE
0012*       PROCEDURE ECUTE(A,B,C,D,E,F,G); INTEGER E, F, G, H;
0013*         INTEGER ARRAY A, B, C, D; CODE;

0015*     THE CALL:
0016*       ECUTE(MV,LM,B,PCVAL,DEPTH,F,BW,MATERIAL);


0018  00000 000000  ECUTE NOP           ENTRY/EXIT
0019  00001 016001X       JSB .PRAM
0020  00002 020000        OCT 20000
0021  00003 000000        OCT 0

0023  00004 000000  MV    OCT 0
0024  00005 000000  LM    OCT 0
0025  00006 000000  B     OCT 0
0026  00007 000000  PCVAL OCT 0
0027  00010 000000  DPT   OCT 0
0028  00011 000000  F     OCT 0
0029  00012 000000  BW    OCT 0
0030  00013 000000  MATL  OCT 0

0032  00014 062004R       LDA MV
0033  00015 042334R       ADA =D3
0034  00016 160000        LDA 0,I
0035  00017 072004R       STA MV
0036  00020 062005R       LDA LM
0037  00021 042334R       ADA =D3
0038  00022 160000        LDA 0,I
0039  00023 072005R       STA LM
0040  00024 062006R       LDA B
0041  00025 042334R       ADA =D3
0042  00026 160000        LDA 0,I
0043  00027 072006R       STA B
0044  00030 062007R       LDA PCVAL
0045  00031 042334R       ADA =D3
0046  00032 160000        LDA 0,I
0047  00033 072007R       STA PCVAL

0049  00034 016002X       DLD MV,I      MOVE THE CURRENT MOVE
      00035 100004R
0050  00036 016003X       DST LM,I      TO MASK POSITION.
      00037 100005R
0051  00040 012335R       AND =B177     MASK FOR DESTINATION
0052  00041 072326R       STA THERE     SQUARE PIECE MOVED TO.
0053  00042 042006R       ADA B         ADD ARRAY ADDRESS.
 PAGE 0003 #01


0054  00043 072331R       STA DST       SAVE IT.
0055  00044 136010R       ISZ DPT,I     INCREMENT THE DEPTH.

0057  00045 162004R       LDA MV,I      GET THE MOVE WORD BACK.
0058*      RRR 7         POSITION FOR SOURCE SQUARE
0059  00046 101107        OCT 101107
0060  00047 012335R       AND =B177     MASK
0061  00050 072325R       STA HERE      SQUARE PIECE MOVED FROM.
0062  00051 042006R       ADA B         ADD ARRAY ADDRESS.
0063  00052 072330R       STA ORG       SAVE IT.

0065  00053 066005R       LDB LM        GET THE LAST MOVE WORD
0066  00054 006004        INB
0067  00055 076327R       STB T.ADD     SAVE THIS ADDRESS IN WORK AREA
0068  00056 160001        LDA 1,I       GET THE SECOND WORD.
0069  00057 012336R       AND =B17      MASK FOR CAPTURE INGO.
0070  00060 072332R       STA CAPT      SAVE IT.
0071  00061 002003        SZA,RSS       ANY CAPTURE ON THIS MOVE?
0072  00062 026207R       JMP NOCAP     NO, GO TO UDATE.

0074  00063 001300        RAR
0075  00064 002011        SLA,RSS
0076  00065 026120R       JMP NOTN      NO, IT ISN'T.

0078  00066 162331R       LDA DST,I     GET THE PIECE CAPTURED.
0079  00067 072333R       STA PIECE     SAVE IT.
0080  00070 162330R       LDA ORG,I     MOVE THE PIECE
0081  00071 172331R       STA DST,I     FROM ORG TO DST.
0082  00072 062332R       LDA CAPT      GET THE CAPTURE INFO
0083  00073 002011        SLA,RSS       EN PASSANT?
0084  00074 026107R       JMP UPD1      NO, CONTINUE

0086  00075 162011R       LDA F,I       EN PASSANT CAPTURE
0087  00076 003004        CMA,INA
0088  00077 072333R       STA PIECE     IF PIECE IS
0089  00100 066331R       LDB DST         NEGATIVE,
0090  00101 002021        SSA,RSS       IF POSITIVE,
0091  00102 046337R       ADB =D-10       SUBTRACT 10.
0092  00103 002020        SSA             THEN
0093  00104 046340R       ADB =D10        ADD 10 TO POSITION
0094  00105 002400        CLA           SET THE POSITION
0095  00106 170001        STA 1,I       TO ZERO, REMOVING THE PIECE.

0097  00107 062333R UPD1  LDA PIECE     GET THE REMOVED PIECE
0098  00110 042341R       ADA =D6       ADJUST FOR POSITIONAL VALUE
0099  00111 042007R       ADA PCVAL     ADD ARRAY START.
0100  00112 160000        LDA 0,I       PIECE VALUE
0101  00113 166012R       LDB BW,I      CHECK
0102  00114 006021        SSB,RSS
0103  00115 003004        CMA,INA
0104  00116 142013R       ADA MATL,I    ADD THE OLD MATERIAL
0105  00117 172013R       STA MATL,I    UPDATE MATERIAL.

0107  00120 062332R NOTN  LDA CAPT      NO NORMAL CAPTURE.
0108  00121 001323        RAR,RAR
0109  00122 002011        SLA,RSS
0110  00123 026152R       JMP NOPRO     NO PROMOTION
 PAGE 0004 #01


0112*     PAWN PROMOTION.

0114  00124 162004R       LDA MV,I
0115  00125 001222        RAL,RAL
0116  00126 012334R       AND =B3
0117  00127 042342R       ADA =D2
0118  00130 166011R       LDB F,I
0119  00131 006020        SSB
0120  00132 003004        CMA,INA
0121  00133 172331R       STA DST,I

0123  00134 062343R       LDA =D100     GET VALUE
0124  00135 166011R       LDB F,I       WHOSE MOVE?
0125  00136 006021        SSB,RSS       IF WHITE,
0126  00137 003004        CMA,INA         THEN SUBTRACT.

0128  00140 166331R       LDB DST,I     GET THE PIECE
0129  00141 046341R       ADB =D6       ADD 6
0130  00142 046007R       ADB PCVAL     FROM STARTING ADDRESS.
0131  00143 164001        LDB 1,I       GET MATERIAL VALUE.
0132  00144 040001        ADA 1         ADD TO PROMOTION.
0133  00145 166012R       LDB BW,I      GET WHITE/BLACK INDICATOR
0134  00146 006021        SSB,RSS       IF WHITE,
0135  00147 003004        CMA,INA         THEN SUBTRACT.
0136  00150 142013R       ADA MATL,I
0137  00151 172013R       STA MATL,I

0139  00152 062332R NOPRO LDA CAPT
0140  00153 012344R       AND =B10
0141  00154 002003        SZA,RSS
0142  00155 026211R       JMP NOCAS

0144*     CASTLE PROCESSING

0146  00156 162330R       LDA ORG,I
0147  00157 172331R       STA DST,I
0148  00160 062325R       LDA HERE
0149  00161 003004        CMA,INA
0150  00162 042326R       ADA THERE
0151  00163 002020        SSA
0152  00164 026176R       JMP QSIDE

0154*     KING SIDE CASTLE PROCESSING

0156  00165 066330R       LDB ORG
0157  00166 046334R       ADB =D3
0158  00167 160001        LDA 1,I
0159  00170 046345R       ADB =D-2
0160  00171 170001        STA 1,I
0161  00172 046342R       ADB =D2
0162  00173 002400        CLA
0163  00174 170001        STA 1,I
0164  00175 026211R       JMP NOCAS

0166*     QUEENSIDE CASTLING

0168  00176 066330R QSIDE LDB ORG
 PAGE 0005 #01


0169  00177 046346R       ADB =D-4
0170  00200 160001        LDA 1,I
0171  00201 046334R       ADB =D3
0172  00202 170001        STA 1,I
0173  00203 046347R       ADB =D-3
0174  00204 002400        CLA
0175  00205 170001        STA 1,I
0176  00206 026211R       JMP NOCAS

0178  00207 162330R NOCAP LDA ORG,I
0179  00210 172331R       STA DST,I
0180  00211 002400  NOCAS CLA
0181  00212 172330R       STA ORG,I
0182  00213 162011R       LDA F,I
0183  00214 003004        CMA,INA
0184  00215 172011R       STA F,I
0185  00216 002020        SSA
0186  00217 026252R       JMP WCAS

0188*     BLACK CASTLE'S

0190  00220 162327R       LDA T.ADD,I
0191  00221 001727        ALF,ALF
0192  00222 001700        ALF
0193  00223 012334R       AND =B3
0194  00224 066347R       LDB =D-3
0195  00225 040001        ADA 1
0196  00226 002021        SSA,RSS
0197  00227 026324R       JMP DONE

0199  00230 062006R       LDA B
0200  00231 042350R       ADA =D95
0201  00232 160000        LDA 0,I
0202  00233 052351R       CPA =D-6
0203  00234 026241R       JMP RCHK
0204  00235 162327R       LDA T.ADD,I
0205  00236 032352R       IOR =B60
0206  00237 172327R       STA T.ADD,I
0207  00240 026324R       JMP DONE

0209  00241 062006R RCHK  LDA B
0210  00242 042353R       ADA =D91
0211  00243 160000        LDA 0,I
0212  00244 052346R       CPA =D-4
0213  00245 026314R       JMP NXT
0214  00246 162327R       LDA T.ADD,I
0215  00247 032354R       IOR =B40
0216  00250 172327R       STA T.ADD,I
0217  00251 026324R       JMP DONE

0219  00252 162327R WCAS  LDA T.ADD,I   WHITE CASTLING RIGHTS
0220  00253 001722        ALF,RAL
0221  00254 001722        ALF,RAL
0222  00255 012334R       AND =B3
0223  00256 066347R       LDB =D-3
0224  00257 040001        ADA 1
0225  00260 002021        SSA,RSS
 PAGE 0006 #01


0226  00261 026324R       JMP DONE
0227  00262 062006R       LDA B
0228  00263 042355R       ADA =D25
0229  00264 160000        LDA 0,I
0230  00265 052341R       CPA =D6
0231  00266 026273R       JMP WQS
0232  00267 162327R       LDA T.ADD,I
0233  00270 032356R       IOR =B300
0234  00271 172327R       STA T.ADD,I
0235  00272 026324R       JMP DONE

0237*     WHITE CASTLES

0239  00273 062006R WQS   LDA B
0240  00274 042357R       ADA =D21
0241  00275 160000        LDA 0,I
0242  00276 052360R       CPA =D4
0243  00277 026324R       JMP DONE
0244  00300 162327R       LDA T.ADD,I   NO, ROOK NOT HERE.
0245  00301 032361R       IOR =B200     SET "ROOK GONE" BIT.
0246  00302 172327R       STA T.ADD,I

0248*     WHITE KINGS SIDE.

0250  00303 062006R       LDA B         CHECK THE KING'S
0251  00304 042362R       ADA =D28        ROOK SQUARE
0252  00305 160000        LDA 0,I       GET THE PIECE IF ANY
0253  00306 052360R       CPA =D4       IS IT A ROOK?
0254  00307 026324R       JMP DONE

0256  00310 162327R       LDA T.ADD,I   NO, ROOK IS GONE.
0257  00311 032363R       IOR =B100     SET "ROOK GONE" BIT.
0258  00312 172327R       STA T.ADD,I
0259  00313 026324R       JMP DONE

0261  00314 062006R NXT   LDA B
0262  00315 042364R       ADA =D98
0263  00316 160000        LDA 0,I
0264  00317 052346R       CPA =D-4
0265  00320 026324R       JMP DONE
0266  00321 162327R       LDA T.ADD,I
0267  00322 032365R       IOR =B20
0268  00323 172327R       STA T.ADD,I
0269  00324 126000R DONE  JMP ECUTE,I
 PAGE 0007 #01


0271*     LOCAL CONSTANTS AND STORAGE

0273  00325 000000  HERE  OCT 0
0274  00326 000000  THERE OCT 0
0275  00327 000000  T.ADD OCT 0
0276  00330 000000  ORG   OCT 0
0277  00331 000000  DST   OCT 0
0278  00332 000000  CAPT  OCT 0
0279  00333 000000  PIECE OCT 0


      00334 000003
      00335 000177
      00336 000017
      00337 177766
      00340 000012
      00341 000006
      00342 000002
      00343 000144
      00344 000010
      00345 177776
      00346 177774
      00347 177775
      00350 000137
      00351 177772
      00352 000060
      00353 000133
      00354 000040
      00355 000031
      00356 000300
      00357 000025
      00360 000004
      00361 000200
      00362 000034
      00363 000100
      00364 000142
      00365 000020
0281                      END
**  NO ERRORS*

CLOSING FILES... DONE
REMOVING TEMP FILE... DONE
VDOS DEV 1.61
? "CHESS2.ASM" "CHESS.REL" ASMB
File exists. Overwrite? N WILL APPEND
PREPARING DOUBLED SOURCE FILE
Writing USB file --TEMP--.ASM
 WAIT...
Closing output buffer
LOADING EXTASMB AND OPENING FILES
LOADING..LOADING.........RUNNING EXTASMB...
AT HALT PRESS THE RUN SWITCH
AT NEXT HALT, SELECT P, SET TO 77000, STORE, RUN
PRESS ANY KEY TO START...
 PAGE 0001


0001                ASMB,R,L,B
**  NO ERRORS*
 PAGE 0002 #01


0001                ASMB,R,L,B
0002  00000               NAM CHES2,7
0003                      ENT SAVE,RETRO
0004                      EXT .ENTR


0006*     THIS ROUTINE SAVES A BOARD POSITION BY STORING THE
0007*     CONTENTS OF THE BOARD ARRAY IN ARRAY POSN.

0009*     CALLING SEQUENCE:
0010*     SET UP EXTERNAL REFERENCE AS FOLLOWS
0011*       PROCEDURE SAVE(A,B,C,D,E,F);
0012*       INTEGER A,B,C,D,E,F; CODE;

0014*     THE CALL:
0015*       SAVE(LM[1],B[21],MATERIAL,DEPTH);



0017  00000 000000  LM    OCT 0
0018  00001 000000  B.1   OCT 0
0019  00002 000000  MATL  OCT 0
0020  00003 000000  DEPTH OCT 0

0022  00004 000000  SAVE  NOP
0023  00005 016001X       JSB .ENTR
0024  00006 000000R       DEF LM
0025  00007 162003R       LDA DEPTH,I
0026  00010 016002X       MPY =D81
      00011 000732R
0027  00012 042104R       ADA P.ADD
0028  00013 072103R       STA BUFA
0029  00014 016003X       DLD LM,I
      00015 100000R
0030  00016 016004X       DST BUFA,I
      00017 100103R
0031  00020 036103R       ISZ BUFA
0032  00021 036103R       ISZ BUFA
0033  00022 162002R       LDA MATL,I
0034  00023 172103R       STA BUFA,I
0035  00024 036103R       ISZ BUFA

0037  00025 062733R       LDA =D-78
0038  00026 072102R       STA I
0039  00027 162001R NEXTM LDA B.1,I     GET THE CURRENT PIECE
0040  00030 172103R       STA BUFA,I
0041  00031 036001R       ISZ B.1
0042  00032 036103R       ISZ BUFA
0043  00033 036102R       ISZ I
0044  00034 026027R       JMP NEXTM
0045  00035 126004R       JMP SAVE,I
 PAGE 0003 #01  PROCEDURE RETRO


0047*     THIS ROUTINE RESTORES THE SITUATION TO THE LAST SAVED
0048*     POSITION BY RETURNING THE ELEMENTS OF POSN TO B.

0050*     CALLING SEQUENCE:
0051*     SET UP AN EXTERNAL REFERENCE AS FOLLOWS;
0052*       PROCEDURE RETRO(A,B,C,D,E,F,G);
0053*       INTEGER A,B,C,D,E,F,G; CODE;

0055*     THE CALL:
0056*       RETRO(LM[1],B[21],F,MATERIAL,DEPTH);



0058  00036 000000  LM1   OCT 0
0059  00037 000000  B1    OCT 0
0060  00040 000000  F     OCT 0
0061  00041 000000  MTL   OCT 0
0062  00042 000000  DPT   OCT 0

0064  00043 000000  RETRO NOP
0065  00044 016001X       JSB .ENTR
0066  00045 000036R       DEF LM1

0068  00046 162040R       LDA F,I
0069  00047 003004        CMA,INA
0070  00050 172040R       STA F,I
0071  00051 003400        CCA
0072  00052 142042R       ADA DPT,I
0073  00053 172042R       STA DPT,I
0074  00054 016002X       MPY =D81
      00055 000732R
0075  00056 042104R       ADA P.ADD
0076  00057 072103R       STA BUFA
0077  00060 016003X       DLD BUFA,I
      00061 100103R
0078  00062 016004X       DST LM1,I
      00063 100036R
0079  00064 036103R       ISZ BUFA
0080  00065 036103R       ISZ BUFA
0081  00066 162103R       LDA BUFA,I
0082  00067 172041R       STA MTL,I
0083  00070 036103R       ISZ BUFA

0085  00071 062733R       LDA =D-78
0086  00072 072102R       STA I
0087  00073 162103R NEXTN LDA BUFA,I
0088  00074 172037R       STA B1,I
0089  00075 036103R       ISZ BUFA
0090  00076 036037R       ISZ B1
0091  00077 036102R       ISZ I
0092  00100 026073R       JMP NEXTN
0093  00101 126043R       JMP RETRO,I

0095  00102 000000  I     OCT 0
0096  00103 000000  BUFA  OCT 0
0097  00104 000105R P.ADD DEF *+1
0098  00105 000000  BUFF  BSS 405
 PAGE 0004 #01  PROCEDURE RETRO


      00732 000121
      00733 177662
0100                      END
**  NO ERRORS*

CLOSING FILES... DONE
REMOVING TEMP FILE... DONE
VDOS DEV 1.61
? "CHESS3.ASM" "CHESS.REL" ASMB
File exists. Overwrite? N WILL APPEND
PREPARING DOUBLED SOURCE FILE
Writing USB file --TEMP--.ASM
 WAIT...
Closing output buffer
LOADING EXTASMB AND OPENING FILES
LOADING..LOADING.........RUNNING EXTASMB...
AT HALT PRESS THE RUN SWITCH
AT NEXT HALT, SELECT P, SET TO 77000, STORE, RUN
PRESS ANY KEY TO START...
 PAGE 0001


0001                ASMB,R,L,B
**  NO ERRORS*
 PAGE 0002 #01


0001                ASMB,R,L,B
0002  00000               NAM SBITF,7
0003                      ENT SBITF
0004                      EXT .ENTR

0006  00000 000000  IWD   NOP
0007  00001 000000  IST   NOP
0008  00002 000000  ILEN  NOP
0009  00003 000000  IVAL  NOP

0011*     THIS IS AN ALGOL/FORTRAN CALLABLE SUBROUTINE WHICH
0012*     WILL SET A BIT FIELD IN A WORD PAIR ACCORDING TO THE VALUE
0013*     TRANSFERRED IN LOCATION IVAL.

0015*     THE VARIABLES HAVE THE FOLLOWING SIGNIFICANCE
0016*       IWD = THE DESTINATION ADDRESS
0017*       IST = THE STARTING BIT OF THE FIELD
0018*       ILEN = LENGTH OF BIT FIELD
0019*       IVAL = VALUE TO BE INCLUDED IN IWD



0021  00004 000000  SBITF NOP           ENTRY/EXIT
0022  00005 016001X       JSB .ENTR     LINK THE PARAMETERS
0023  00006 000000R       DEF IWD
0024  00007 162002R       LDA ILEN,I    GET THE BIT LENGTH
0025  00010 042074R       ADA TABLE     ADD STARTING ADDRESS
0026  00011 160000        LDA 0,I       GET DESIRED MASK
0027  00012 072073R       STA MASK      SAVE FOR LATER USE
0028  00013 162001R       LDA IST,I     GET STARTING BIT LOCATION
0029  00014 012114R       AND =B20      CHECK FOR A/B REG
0030  00015 072070R       STA FLAG

0032  00016 016033R       JSB INST
0033  00017 016045R       JSB SWAP
0034  00020 016002X       DLD IWD,I
      00021 100000R
0035* .SWP  SWP
0036  00022 101100  .SWP  OCT 101100
0037* SW.1  RRR 8
0038  00023 101110  SW.1  OCT 101110
0039  00024 012073R       AND MASK
0040  00025 132003R       IOR IVAL,I    INCLUDE THE DATA
0041* SWP.  SWP
0042  00026 101100  SWP.  OCT 101100
0043* L.INS RRL 4         TO STARTING POSITION
0044  00027 100104  L.INS OCT 100104
0045  00030 016003X       DST IWD,I
      00031 100000R
0046  00032 126004R       JMP SBITF,I

0048  00033 000000  INST  NOP           ENTRY/EXIT
0049  00034 162001R       LDA IST,I
0050  00035 012115R       AND =B17
0051  00036 070001        STA 1
0052  00037 072072R       STA FL2
0053  00040 032071R       IOR RRL
 PAGE 0003 #01


0054  00041 072027R       STA L.INS
0055  00042 032116R       IOR =B1000
0056  00043 072023R       STA SW.1
0057  00044 126033R       JMP INST,I

0059  00045 000000  SWAP  NOP           ENTRY
0060  00046 062070R       LDA FLAG
0061  00047 066072R       LDB FL2
0062  00050 002002        SZA
0063  00051 026061R       JMP .SWAP
0064  00052 072022R       STA .SWP
0065  00053 072026R       STA SWP.
0066  00054 006002        SZB
0067  00055 026060R       JMP .FIN
0068  00056 072023R       STA SW.1
0069  00057 072027R       STA L.INS
0070  00060 126045R .FIN  JMP SWAP,I
0071  00061 062067R .SWAP LDA .SWP.
0072  00062 006003        SZB,RSS
0073  00063 002400        CLA
0074  00064 072022R       STA .SWP
0075  00065 072026R       STA SWP.
0076  00066 126045R       JMP SWAP,I

0078* .SWP. SWP
0079  00067 101100  .SWP. OCT 101100
0080  00070 000000  FLAG  NOP
0081  00071 100100  RRL   OCT 100100
0082  00072 000000  FL2   NOP
0083  00073 000000  MASK  OCT 0
0084  00074 000074R TABLE DEF *
0085  00075 177776        OCT 177776,177774,177770,177760,177740
      00076 177774
      00077 177770
      00100 177760
      00101 177740
0086  00102 177700        OCT 177700,177600,177400,177000,176000
      00103 177600
      00104 177400
      00105 177000
      00106 176000
0087  00107 174000        OCT 174000,170000,160000,140000,100000
      00110 170000
      00111 160000
      00112 140000
      00113 100000

      00114 000020
      00115 000017
      00116 001000
0089                      END
**  NO ERRORS*

CLOSING FILES... DONE
REMOVING TEMP FILE... DONE
VDOS DEV 1.61
? "CHESS4.ASM" "CHESS.REL" ASMB
File exists. Overwrite? N WILL APPEND
PREPARING DOUBLED SOURCE FILE
Writing USB file --TEMP--.ASM
 WAIT...
Closing output buffer
LOADING EXTASMB AND OPENING FILES
LOADING..LOADING.........RUNNING EXTASMB...
AT HALT PRESS THE RUN SWITCH
AT NEXT HALT, SELECT P, SET TO 77000, STORE, RUN
PRESS ANY KEY TO START...
 PAGE 0001


0001                ASMB,R,L,B
**  NO ERRORS*
 PAGE 0002 #01


0001                ASMB,R,L,B
0002  00000               NAM CBITF,7
0003                      ENT CBITF
0004                      EXT .ENTR

0006  00000 000000  IWD   NOP
0007  00001 000000  IORG  NOP
0008  00002 000000  ILEN  NOP

0010*     THIS IS AN ALGOL/FORTRAN CALLABLE SUBROUTINE TO
0011*     EXTRACT A BIT FIELD FROM A WORD PAIR.

0013*     THE PARAMETERS HAVE THE FOLLOWING MEANING.
0014*       IWD = ADDRESS OF FIRST WORD OF PAIR
0015*       IORG = STARTING BIT LOCATION
0016*       ILEN = LENGTH OF BIT FIELD



0018  00003 000000  CBITF NOP           ENTRY/EXIT
0019  00004 016001X       JSB .ENTR     LINK THE
0020  00005 000000R       DEF IWD         PARAMETERS
0021  00006 162002R       LDA ILEN,I    GET THE BIT LENGTH
0022  00007 042047R       ADA TABLE     ADD STARTING ADDRESS
0023  00010 160000        LDA 0,I       GET THE MASK DESIRED.
0024  00011 072046R       STA MASK      SAVE IT.

0026  00012 162001R       LDA IORG,I    GET THE STARTING POSITION
0027  00013 012067R       AND =B20      MASK FOR A/B REG IND
0028  00014 072044R       STA FLAG

0030  00015 162001R       LDA IORG,I    GET IT BACK
0031  00016 012070R       AND =B17      FIND NO. OF BITS
0032  00017 070001        STA 1         SAVE FOR
0033  00020 032045R       IOR RRR       INCLUDE THE INSTRUCTION
0034  00021 072040R       STA SW.1      PUT IN SEQUENCE

0036  00022 062044R       LDA FLAG      GET THE FLAG
0037  00023 002002        SZA
0038  00024 026031R       JMP .SWAP
0039  00025 072037R       STA .SWP
0040  00026 006002        SZB
0041  00027 026035R       JMP LOAD
0042  00030 072040R       STA SW.1
0043  00031 062043R .SWAP LDA .SWP.
0044  00032 006003        SZB,RSS
0045  00033 002400        CLA
0046  00034 072037R       STA .SWP

0048  00035 016002X LOAD  DLD IWD,I
      00036 100000R
0049* .SWP  SWP
0050  00037 101100  .SWP  OCT 101100
0051* SW.1  RRR 4         POSITION
0052  00040 101104  SW.1  OCT 101104
0053  00041 012046R       AND MASK      MASK FOR DESIRED BITS.
0054  00042 126003R       JMP CBITF,I   RETURN
 PAGE 0003 #01


0056* .SWP. SWP
0057  00043 101100  .SWP. OCT 101100
0058  00044 000000  FLAG  NOP
0059  00045 101100  RRR   OCT 101100
0060  00046 000000  MASK  NOP
0061  00047 000047R TABLE DEF *
0062  00050 000001        OCT 1,3,7,17,37,77,177
      00051 000003
      00052 000007
      00053 000017
      00054 000037
      00055 000077
      00056 000177
0063  00057 000377        OCT 377,777,1777,3777,7777,17777,37777,77777
      00060 000777
      00061 001777
      00062 003777
      00063 007777
      00064 017777
      00065 037777
      00066 077777

      00067 000020
      00070 000017
0065                      END
**  NO ERRORS*

CLOSING FILES... DONE
REMOVING TEMP FILE... DONE
VDOS DEV 1.61
? "CHESS5.ASM" "CHESS.REL" ASMB
File exists. Overwrite? N WILL APPEND
PREPARING DOUBLED SOURCE FILE
Writing USB file --TEMP--.ASM
 WAIT...
Closing output buffer
LOADING EXTASMB AND OPENING FILES
LOADING..LOADING.........RUNNING EXTASMB...
AT HALT PRESS THE RUN SWITCH
AT NEXT HALT, SELECT P, SET TO 77000, STORE, RUN
PRESS ANY KEY TO START...
 PAGE 0001


0001                ASMB,R,L,T,B
B       000001
.MPY  X 000001
BLANK R 000006
BLNKS R 000063
BUFL  R 000067
CCNT  R 000072
GETAD R 000027
IZERO R 000000
MODE  R 000071
MULT  R 000057
NEXT  R 000045
RETN  R 000066
RSTR  R 000022
TABLE R 000070
TEMP  R 000065
WORD  R 000064
WORK  R 000013
ZERO  R 000000
**  NO ERRORS*
 PAGE 0002 #01


0001                ASMB,R,L,T,B
0002  00000               NAM ZERO,7
0003                      ENT ZERO,BLANK,IZERO
0004  00001         B     EQU 1


0006*     PURPOSE:
0007*       THIS IS AN ALGOL COMPATIBLE ROUTINE WHICH STORES
0008*       ZEROES OR ASCII BLANKS THROUTHOUT AN ARRAY.  IT IS
0009*       MOST USEFUL WHEN REPEATED CALLS TO THE LIBRARY
0010*       "INDEX" ROUTINE WOULD TEND TO SLOW PROGRAM EXECUTION

0012*     LENGTH:
0013*       THIS ROUTINE REQUIRES 56 DECIMAL (70 OCTAL) WORDS.

0015*     CALLING SEQUENCE:
0016*       AN EXTERNAL PROCEDURE DECLARATION IS MADE IN THE
0017*     CALLING PROGRAM IN THE FOLLOWING MANNER:
0018*         PROCEDURE IZERO(ARRY); INTEGER ARRAY ARRY; CODE;
0019*         PROCEDURE ZERO(ARRR); ARRAY ARRR; CODE;
0020*         PROCEDURE BLANK(IARRY); INTEGER ARRAY IARRY; CODE;
0021*                   PROCEDURE EXECUTION IS INVOKED IN THE
0022*                   NORMAL MANNER.



0024  00000 000000  ZERO  NOP           ENTRY POINT
0025  00000         IZERO EQU ZERO
0026  00001 062000R       LDA ZERO      GET AND SAVE THE
0027  00002 072065R       STA TEMP        STACK POINTER.
0028  00003 002400        CLA           SET TO ZERO THE ARRAY.
0029  00004 072064R       STA WORD
0030  00005 026013R       JMP WORK      GO GET SIZE AND ADDRESS.

0032  00006 000000  BLANK NOP           ENTRY POINT.
0033  00007 062006R       LDA BLANK     GET AND SAVE THE
0034  00010 072065R       STA TEMP        STACK POINTER.
0035  00011 062063R       LDA BLNKS     SET TO BLANK
0036  00012 072064R       STA WORD        THE ARRAY.

0038  00013 162065R WORK  LDA TEMP,I    GET AND SAVE THE
0039  00014 001275        RAL,CLE,SLA,ERA
0040  00015 160000        LDA 0,I
0041  00016 072066R       STA RETN        RETURN ADDRESS
0042  00017 036065R       ISZ TEMP      BUMP THE STACK POINTER.
0043  00020 016027R       JSB GETAD     GO GET THE ARRAY PARAMETERS.
0044  00021 062064R       LDA WORD      LOAD THE WORD TO BE USED.

0046  00022 170001  RSTR  STA B,I       PUT IT IN THE ARRAY.
0047  00023 006004        INB           BUMP THE ADDRESS.
0048  00024 036067R       ISZ BUFL      DONE?
0049  00025 026022R       JMP RSTR        NO, DO IT AGAIN.
0050  00026 126066R       JMP RETN,I      YES, RETURN TO CALLER.

0052  00027 000000  GETAD NOP           ENTRY/EXIT
0053  00030 162065R       LDA TEMP,I    GET THE ARRAY STACK
0054  00031 072070R       STA TABLE       TABLE ADDRESS.
 PAGE 0003 #01


0055  00032 162070R       LDA TABLE,I   GET NO. OF INDICES.
0056  00033 006400        CLB           IF ARRAY IS REAL,
0057  00034 002020        SSA             B=/,
0058  00035 007400        CCB             OTHERWISE, B=1
0059  00036 076071R       STB MODE        FOR MODE FLAG.
0060  00037 002021        SSA,RSS       FORCE THE NUMBER
0061  00040 003004        CMA,INA         NEGATIVE AND
0062  00041 072072R       STA CCNT        SET THE COUNTER.
0063  00042 036070R       ISZ TABLE     SET TO POINT TO SIZE
0064  00043 162070R       LDA TABLE,I     OF FIRST DIMENSION
0065  00044 036070R       ISZ TABLE     BUMP POINTER AGAIN.

0067  00045 036070R NEXT  ISZ TABLE     BUMP THE POINTER
0068  00046 036072R       ISZ CCNT      IF NOT FINIXHED, GO
0069  00047 026057R       JMP MULT        MULTIPLY THE DIMENSIONS.

0071  00050 003004        CMA,INA       MAKE THE RESULT NEGATIVE.
0072  00051 066071R       LDB MODE      IF THE ARRAY WAS REAL,
0073  00052 006003        SZB,RSS         THEN
0074  00053 001000        ALS             DOUBLE, AND
0075  00054 072067R       STA BUFL        SAVE THE LENGTH.
0076  00055 166070R       LDB TABLE,I   GET THE STAATINT ADDRESS.
0077  00056 126027R       JMP GETAD,I     AND RETURN.

0079  00057 016001X MULT  MPY TABLE,I   MULTIPLY THE TWO
      00060 100070R
0080  00061 036070R       ISZ TABLE       DIMENSIONS FOR ABS(SIZE).
0081  00062 026045R       JMP NEXT      FOR NEXT DIMENSION.
-l PAGE 0004 #01


0083*     CONSTANTS AND STORAGE

0085  00063 020040  BLNKS OCT 20040
0086  00064 000000  WORD  OCT 0
0087  00065 000000  TEMP  OCT 0
0088  00066 000000  RETN  OCT 0
0089  00067 000000  BUFL  OCT 0
0090  00070 000000  TABLE OCT 0
0091  00071 000000  MODE  OCT 0
0092  00072 000000  CCNT  OCT 0

0094                      END
**  NO ERRORS*

CLOSING FILES... DONE
REMOVING TEMP FILE... DONE
VDOS DEV 1.61
? "CHESS.REL" "CHESS.ABS" LINK
PREPARING REL FILE WITH LIBRARY
Writing USB file --TEMP--.REL
 WAIT...
Closing output buffer
LOADING BCS LINKER AND ATTACHING FILES
LOADING...........RUNNING BCS LINKER...
AT HALT, PRESS RUN AGAIN TO LOAD MORE MODULES
(I.E. IF REL HAS 6 MODULES PRESS RUN 5 TIMES)
AFTER ALL LOADED, SELECT S, SET BIT 2, STORE, RUN
AT NEXT HALT, RUN AGAIN TO OUTPUT ABS
WHEN *END DISPLAYED, HALT, SELECT P, SET TO 77000, STORE, RUN
(IF SR BIT 15 WAS SET TO SUPPRESS, CLEAR FIRST)
PRESS ANY KEY TO START...


  CHESS


 02000 17051


 00270 00753


*LOAD


  ECUTE


 17052 17437


*LOAD


  CHES2


 17440 20373


*LOAD


  SBITF


 20374 20512


*LOAD


  CBITF


 20513 20603


*LOAD


  ZERO,


 20604 20676


*LOAD


  FRMTR


 20677 23307


 00754 01241


  INDEX


 23310 23422


 01242 01245


  .ITOI


 23423 23530


 01246 01252


  .PRAM


 23531 23624


 01253 01266


  FLOAT


 23625 23631


  .PACK


 23632 23726


 01267 01276


  .ENTR


 23727 23766


 01277 01302


  MPY


 23767 24105


 01303 01306


  DIV


 24106 24175


 01307 01316


  DLDST


 24176 24236


 01317 01320


  GETAD


 24237 24252


 01321 01322


  IFIX


 24253 24304


 01323 01325


  .STOP


 24305 24321


  .ERRR


 24322 24373


 01326 01327


  .SWCH


 24374 24411


 01330 01330


  .FLUN


 24412 24422


 01331 01332


  ENDIO


 24423 24431


*LST
.IOC.  74126
.SQT.  74103
.MEM.  74075
.BUFR  74277
HALT   74070
.INDR  23314
.IOI.  22553
.PRAM  23531
.DIO.  22673
.DTA.  23003
BLANK  20612
.INDA  23310
.DIV   24106
.MPY   23767
CBITF  20516
SBITF  20400
.ITOI  23423
.SWCH  24374
SAVE   17444
ECUTE  17052
RETRO  17503
IZERO  20604
.STOP  24305
.DLD   24176
.DST   24211
.ENTR  23727
ZERO   20604
.BIO.  22752
.IAR.  22627
.IOR.  22523
.RAR.  22603
OLDIO  21105
.FLUN  24412
.PACK  23632
ENDIO  24423
FLOAT  23625
IFIX   24253
.ERRR  24322
ADRES  01321
GETAD  24237


 *LINKS
 01621 01777


*END

CLOSING FILES... DONE
REMOVING TEMP FILE... DONE
VDOS DEV 1.61
? "CHESS.ABS" VLOAD
LOADING..................................................................................................................................
Run from 77000 to return

HP CHESS VERSION A  10/26/73

DUMPS AVAILABLE:
     SW0 - MOVE LIST
     SW1 - BOTTOM NODE DUMP
     SW2 - FULL DUMP



TYPE 1 FOR A NEW GAME, 0 FOR OLD 1
CHOICE: (B=1, W=-1) -1
1

 MOVE=  1

      ---------------------------------
  90  !*R !*N !*B !*Q !*K !*B !*N !*R !
      ---------------------------------
  80  !*P !*P !*P !*P !*P !*P !*P !*P !
      ---------------------------------
  70  !   !   !   !   !   !   !   !   !
      ---------------------------------
  60  !   !   !   !   !   !   !   !   !
      ---------------------------------
  50  !   !   !   !   !   !   !   !   !
      ---------------------------------
  40  !   !   !   !   !   !   !   !   !
      ---------------------------------
  30  ! P ! P ! P ! P ! P ! P ! P ! P !
      ---------------------------------
  20  ! R ! N ! B ! Q ! K ! B ! N ! R !
      ---------------------------------
0       1   2   3   4   5   6   7   8


YOUR TURN: FROM SQUARE? 33
TO SQUARE? 53
 YOU MOVED FROM 33 TO 53


 MY MOVE FROM 85 TO 65


1

 MOVE=  2

      ---------------------------------
  90  !*R !*N !*B !*Q !*K !*B !*N !*R !
      ---------------------------------
  80  !*P !*P !*P !*P !   !*P !*P !*P !
      ---------------------------------
  70  !   !   !   !   !   !   !   !   !
      ---------------------------------
  60  !   !   !   !   !*P !   !   !   !
      ---------------------------------
  50  !   !   ! P !   !   !   !   !   !
      ---------------------------------
  40  !   !   !   !   !   !   !   !   !
      ---------------------------------
  30  ! P ! P !   ! P ! P ! P ! P ! P !
      ---------------------------------
  20  ! R ! N ! B ! Q ! K ! B ! N ! R !
      ---------------------------------
0       1   2   3   4   5   6   7   8


YOUR TURN: FROM SQUARE?
VDOS DEV 1.61
? VDIR

. DIR
.. DIR
ALGOL.ABS
REVERSI.FTN
BCSLIB.REL
CHESS.ALG
CHESS.TXT
CHESS1.ASM
CHESS2.ASM
CHESS3.ASM
CHESS4.ASM
CHESS5.ASM
EXTASMB.ABS
FORTRAN1.ABS
FORTRAN2.ABS
HPIPLOS1.ASM
CHESS.REL
REVERSI.REL
REVERSI.ABS
SIO.ABS
VINTAGE.IPL
CHESS.ABS
VDOSDEV.ABS
BCS.ABS
D:\>

-----------------------------------------------------------
This HP2113 session was recorded Nov 23 2010 using an early
version of the vintage compiler words, edited Nov 25 2010 to
remove the VINTAGE.IPL listing which had a flawed LINK word.
The latest vintage.ipl package for HP-IPL/OS and VDOS is at:
http://newton.freehostia.com/hp/vintage.ipl.txt
Details about the HP21xx USB disk adapter are at:
http://newton.freehostia.com/hp/usbadapter.html