Reversi for HP FORTRAN

To Know is To Use and Experience... reading about an old language isn't nearly as satisfying as actually writing software in that language. Reversi is one of my favorite board games and I've already written a BASIC version so it was a good choice for my first non-trivial HP FORTRAN program. The end result was another ABS program I can run on my HP2113E minicomputer or under simulation, in the reversi.zip file (along with derivitive versions, some adaptable to compile for a PC).

Documentation made all the difference in the world, thankfully I found a copy of the 1973 version of HP FORTRAN, not identical to the version I have but close enough. Learning the language was a breeze, there just isn't much of it. That's a good thing! These days learning a new programming language is quite difficult because of the (in my opinion) excessive complexity of all things modern, I found that subroutines and even recursion could be easily implemented using only simple conditional branches and soon I found myself concentrating on the algorithm with little concern for the apparent limitations of the language. All that's needed to write just about any program are arrays and variables, math, comparisons, branching and I/O, all that other stuff is just more stuff that has to be learned before it becomes useful. Even loop constructs aren't strictly necessary but nice to have, especially when it's something simple like DO. Structured goto-less programming is fine and all that but it's refreshing to write code in a language where GO TO is king. Long Live Spaghetti Code! (ducking...)

Before I could do much of anything I had to learn how to efficiently compile and test my code, so I wrote a HP-IPL/OS program that takes information about the source files and outputs a SimH HP2100 simulator script that carries out all the steps needed to compile and link the source into an ABS file. Once the build script was made I could edit code, right-click and "run" the build script, then right-click and simulate the new binary right away without having to go through all the steps normally needed to operate the vintage compiler and linker software. I feel a tinge of guilt for making it so easy but not everything has to be authentic, I wanted to make a Reversi program in FORTRAN, not practice typing at the simulator prompt (which isn't authentic anyway).

Probably the only real limitation I encountered was I couldn't figure out how to output text without it adding a CRLF, making it impossible to accept input from anywhere besides column 1 [but the solution ended up being trivial, page down]. I prefer to enter my moves after a MOVE? prompt and an extra line wouldn't have permitted the large board format I wanted to use, so figuring it couldn't be that hard to print text I wrote a print routine in assembly. Only it wasn't exactly easy... the interrupt-driven BCS console driver induced problems like printing the text before the line that was supposed to have already been printed, and adding a LF after each character. To make it work I had to add a delay to permit previous prints to complete and turn off interrupts while printing my stuff, not an ideal solution but it functions. So long as the terminal isn't too slow.

Here's the Reversi-playing code I came up with...

FTN,B,L,A
C
C REVERSI for HP21xx FORTRAN 11/4/07 WTN
C Requires PRT subroutine to print prompts
C
DIMENSION IBRD(10,10),JBRD(10,10)
DIMENSION IWTS(10,10),JWTS(10,10)
DIMENSION MPR(6),LAGN(9)
C-- Lookahead levels.. 0 = none, 1 = consider next human move,
C-- 2 = consider computer move after that, 3 = consider human
C-- move after that. Lookahead disabled while looking ahead.
C-- Start out at level 1
LEVEL=1
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-- Ascii piece codes
NEMPT=32
NHUMN=79
NMACH=88
C-- Initialize MPR to " MOVE? "
MPR(1)=20040B
MPR(2)=20040B
MPR(3)=46517B
MPR(4)=53105B
MPR(5)=37440B
MPR(6)=0
C-- Initialize LAGN to " PLAY AGAIN? "
LAGN(1)=20040B
LAGN(2)=20040B
LAGN(3)=50114B
LAGN(4)=40531B
LAGN(5)=20101B
LAGN(6)=43501B
LAGN(7)=44516B
LAGN(8)=37440B
LAGN(9)=0
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 115 I = 2,9
IWTS(I,2)=NSIDE
IWTS(I,9)=NSIDE
IWTS(2,I)=NSIDE
IWTS(9,I)=NSIDE
115 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
IME=2
IYOU=2
C-- Print title line and instructions
WRITE(1,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 CALL PRT (MPR(1))
READ(1,210)IHY,IHX
210 FORMAT(I1,I1)
C-- if 99 entered terminate
NTEMP=IHX+IHY*10
IF (NTEMP-99)212,370,212
C-- If pass (0) then don't display unchanged board
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)235,300,300
C-- Generate machine move
C-- bump counter to help randomize moves
235 ITWDL=ITWDL+1
IPHAS=1
LCTL3=1
GO TO 3000
240 IF (IMY)900,250,242
242 LX=IMX-1
LY=IMY-1
WRITE(1,245)LY,LX
245 FORMAT(" MY MOVE IS ",I1,I1)
GO TO 200
250 WRITE(1,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(1,320)NTEMP
GO TO 370
315 IF (NTEMP-1)316,317,316
316 WRITE(1,322)NTEMP
GO TO 370
317 WRITE(1,325)NTEMP
GO TO 370
320 FORMAT(" YOU WON BY ",I2," PIECES")
322 FORMAT(" YOU WON BY ",I1," PIECES")
325 FORMAT(" YOU WON BY ",I1," PIECE")
330 WRITE(1,340)
340 FORMAT(" IT'S A TIE GAME")
GO TO 370
350 IF (NTEMP-9)355,355,352
352 WRITE(1,360)NTEMP
GO TO 370
355 IF (NTEMP-1)356,357,356
356 WRITE(1,362)NTEMP
GO TO 370
357 WRITE(1,365)NTEMP
360 FORMAT(" I WON BY ",I2," PIECES")
362 FORMAT(" I WON BY ",I1," PIECES")
365 FORMAT(" I WON BY ",I1," PIECE")
C-- display play again prompt
370 CALL PRT (LAGN(1))
READ(1,380)NTEMP
380 FORMAT(A1)
C-- run again if Y entered
IF (NTEMP-89)400,100,400
C-- prompt for end-of-game options
400 WRITE(1,1015)
WRITE(1,401)
401 FORMAT("ENTER D FOR DUMP, L FOR LEVEL, W TO CHANGE WEIGHTS")
READ(1,380)NTEMP
IF (NTEMP-68)402,404,402
402 IF (NTEMP-87)403,700,403
403 IF (NTEMP-76)600,800,600
C-- dump variables
404 WRITE(1,405)
405 FORMAT("IBRD ARRAY:")
DO 407 J = 1,10
WRITE(1,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(1,410)
410 FORMAT("IWTS ARRAY:")
DO 415 J = 1,10
WRITE(1,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(1,420)IGAIN,IAG,IMG
WRITE(1,424)IMX,IMY,ITBRK
WRITE(1,427)ITWDL,MX,MY
WRITE(1,430)NEMPT,NHUMN,NMACH
WRITE(1,455)NMIDL,NSIDE,NEXT2
WRITE(1,470)NCORN,NNX2C,IFLIP
WRITE(1,490)IPHAS,LCTL1,LCTL3
WRITE(1,505)LCTL4,JMX,JMY
WRITE(1,520)JIMG,JIMX,JIMY
WRITE(1,535)JIAG,JGAIN,LEVEL
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)
505 FORMAT("LCTL4 = ",I6," JMX = ",I6," JMY = ",I6)
520 FORMAT("JIMG = ",I6," JIMX = ",I6," JIMY = ",I6)
535 FORMAT("JIAG = ",I6," JGAIN = ",I6," LEVEL = ",I6)
600 STOP
C-- input new weights
690 FORMAT(I2)
700 WRITE(1,710)
710 FORMAT("ENTER WEIGHTS, MIN 1 MAX 99")
WRITE(1,720)
720 FORMAT("MIDDLE POSITIONS...")
READ(1,690)NMIDL
WRITE(1,730)
730 FORMAT("SIDE POSITIONS...")
READ(1,690)NSIDE
WRITE(1,740)
740 FORMAT("NEXT-TO CORNERS...")
READ(1,690)NEXT2
WRITE(1,750)
750 FORMAT("CORNERS...")
READ(1,690)NCORN
WRITE(1,760)
760 FORMAT("NEXT-TO AFTER CORNER OCCUPIED...")
READ(1,690)NNX2C
GO TO 100
C-- input new level
790 FORMAT(I1)
800 WRITE(1,810)
810 FORMAT("ENTER PLAY LEVEL (0-3)")
READ(1,790)LEVEL
GO TO 100
C-- program error
900 WRITE(1,910)
910 FORMAT("BUG IN PROGRAM")
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(1,1015)
WRITE(1,1010)
WRITE(1,1011)
DO 1005 J = 2,9
K=J-1
WRITE(1,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),K
IF (J-9)1002,1005
1002 WRITE(1,1013)
1005 CONTINUE
WRITE(1,1014)
WRITE(1,1010)
WRITE(1,1015)
WRITE(1,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," | ",I1)
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 IF (MY-2)2900,2020
2020 IF (9-MX)2900,2030
2030 IF (9-MY)2900,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 IF (IGAIN)900,2900,2070
C-- adjust scores and display board
2070 IYOU=IYOU+IGAIN+1
IME=IME-IGAIN
GO TO 220
C-- here if invalid move
2900 WRITE(1,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 IF (IGAIN)900,3100,3022
C-- calculate adjusted gain based on position
3022 IAG=IGAIN*IWTS(MX,MY)
C-- look ahead one move to predict what human will play
C-- and modify IAG (but not if already looking ahead)
IF (LEVEL)900,3025,3023
3023 IF (LCTL3-1)900,3200,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)
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
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 IF (IGAIN)900,900,3155
C-- exit if looking ahead
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.
3200 CONTINUE
C-- save arrays
DO 3210 I = 2,9
DO 3210 J = 2,9
JBRD(I,J)=IBRD(I,J)
JWTS(I,J)=IWTS(I,J)
3210 CONTINUE
C-- save variables
JMX=MX
JMY=MY
JIMG=IMG
JIMX=IMX
JIMY=IMY
JIAG=IAG
JGAIN=IGAIN
C-- go ahead and make move
IFLIP=1
LCTL4=4
GO TO 4000
C-- set up and call to predict player move
3220 IPHAS=0
LCTL3=2
GO TO 3000
C-- calculate adjusted gain if human didn't pass
3230 KIAG=JIAG
IF (IMY)900,3250,3240
3240 KIAG=JIAG-IMG
C-- if level 1 stop looking ahead (error if level 0)
3250 IF (LEVEL-1)900,3400,3260
C-- set up and call to predict next computer move
3260 IPHAS=1
LCTL3=3
GO TO 3000
C-- calculate adjusted gain if computer didn't pass
3270 IF (IMY)900,3290,3280
3280 KIAG=KIAG+IMG
C-- if level 2 stop looking ahead (error if level 1)
3290 IF (LEVEL-2)900,3400,3300
C-- set up and call to predict next human move
3300 IPHAS=0
LCTL3=4
GO TO 3000
C-- calculate adjusted gain if human didn't pass
3310 IF (IMY)900,3400,3320
3320 KIAG=KIAG-IMG
C-- restore arrays and variables
3400 IAG=KIAG
DO 3410 I = 2,9
DO 3410 J = 2,9
IBRD(I,J)=JBRD(I,J)
IWTS(I,J)=JWTS(I,J)
3410 CONTINUE
MX=JMX
MY=JMY
IMG=JIMG
IMX=JIMX
IMY=JIMY
IGAIN=JGAIN
LCTL3=1
IPHAS=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 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$

Here's the code for the PRT subroutine...

ASMB,R,B,L
NAM PRT,7
*
* PRT (N) - Subroutine for printing whatever without printing CRLF
* Entry - one 16 bit word specifying an address where it can find text
* Action - prints each 16 bit value starting at address to TTY slot 11
* as two characters, high byte then low byte, continuing until a 0 is
* read from memory. Change TERMI value to use another terminate value.
* Hard-coded for TTY in slot 11, change all 11B's if different.
* Alter PDELA value to change the delay time to ensure previously
* printed strings get printed, otherwise they'll print after this.
* Disables interrupts while printing, not for real-time apps.
*
* Example usage (from FORTRAN Reversi program)...
* DIMENSION MPR(6)
* ----
* C-- Initialize MPR to " MOVE? "
* MPR(1)=20040B
* MPR(2)=20040B
* MPR(3)=46517B
* MPR(4)=53105B
* MPR(5)=37440B
* MPR(6)=0
* ----
* 208 CALL PRT (MPR(1))
* READ(1,210)IHY,IHX
* 210 FORMAT(I1,I1)
* ----
* ...this code prints 4 spaces MOVE? space, and gets keyboard input.
* Leaves IHY set to 1st digit, IHX set to 2nd digit according to the
* format statement, modify to input other stuff. The numbers for
* the array were derived using OCT_TOOL (in hpos_utl.zip), entering
* xx MOVE? xx, ignoring the dummy doubles to keep the spaces.
*
* 11/4/07 WTN using code swiped from Octapus D. Free, no warranty.
*
ENT PRT
EXT .ENTR
PDELA DEC -30000 NEGATIVE DELAY FACTOR
LISTA OCT 0
WPTR OCT 0 WORD POINTER
TERMI OCT 0 TERMINATE BY 0
TEMP1 OCT 0
CW2 OCT 120000
M177 OCT 177
PRT NOP
JSB .ENTR
DEF LISTA
* DELAY TO ALLOW LAST PRINT TO COMPLETE...
LDA PDELA GET DELAY FACTOR
STA TEMP1 SAVE TO LOOP ON
PRTD JMP *+1 WASTE
JMP *+1 CPU
JMP *+1 CYCLES
JMP *+1
JMP *+1
JMP *+1
JMP *+1
JMP *+1
JMP *+1
ISZ TEMP1 INC LOOP VAR
JMP PRTD KEEP LOOPING UNTIL 0
* NOW PRINT DIRECTLY...
CLF 0B TURN OFF INTERRUPTS
LDA LISTA GET TEXT ADDRESS
STA WPTR INIT POINTER
JSB PRSUB CALL PRINT SUB
CLC 11B CLEAR CONTROL AND
STF 11B SET FLAG TO CANCEL INT
STF 0B ENABLE INTERRUPTS
JMP PRT,I RETURN
PRSUB NOP
PRTLP LDA WPTR,I GET WORD POINTED TO BY WPTR
CPA TERMI COMPARE TO TERMINATE WORD
JMP PRSUB,I IF EQUAL THEN RETURN
JSB PRTWD PRINT 2 CHARS
ISZ WPTR INCREMENT POINTER
JMP PRTLP DO SOME MORE
JMP PRSUB,I DONT RUNAWAY
*
PRTWD NOP PRINT 16 BIT WORD IN ASCII
STA TEMP1
ALF,ALF
AND M177
JSB CHARO
LDA TEMP1
JSB CHARO
JMP PRTWD,I
*
CHARO NOP OUTPUT ONE CHARACTER
* CHANGE 11B'S IF TTY NOT IN SLOT 11
LDB CW2
OTB 11B
AND M177
OTA 11B
STC 11B,C
SFS 11B
JMP *-1
JMP CHARO,I
*
END
END$

And here's some of a run session...

 *** REVERSI ***  YOU=O ME=X MOVES=YX

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

YOU: 2 ME: 2
MOVE? 34

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

YOU: 4 ME: 1
MY MOVE IS 33

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

YOU: 3 ME: 3
MOVE? 56

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

YOU: 5 ME: 2
MY MOVE IS 66

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

YOU: 4 ME: 4
MOVE? 43

. . . . . . . . . . . .

MOVE? 28

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

YOU: 42 ME: 19
MY MOVE IS 72

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

YOU: 35 ME: 27
MOVE? 81

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

YOU: 41 ME: 22
MY MOVE IS 71

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

YOU: 40 ME: 24
YOU WON BY 16 PIECES
PLAY AGAIN? N

That was at lookahead level 1. Often it beats me, especially if I slip it up and let it get an advantage. The program can look ahead up to 3 moves but that doesn't necessarily make it play better, lookahead is effective only if I choose the moves it thinks I'll make, which over 3 moves is not likely. The program doesn't have much of a strategy other than a weighting table to indicate how valuable certain positions are - side positions are specified as more worthy than middle positions, corners are the most desireable, and positions next to the corners are somewhat avoided until the associated corner position is filled. I'm sure there are better or additional strategies that can be employed, perhaps increasing the side next-to weight if the rest of that side has already been filled.

To select a move the computer scans the entire board and for each empty position looks in all 8 directions to see if there is one of its pieces in that direction, if so it counts the number of opponent pieces in between, adding to a "gain" variable. Once the piece gain has been computed it's multiplied by the weight factor for that position to score the possible move. If lookahead is greater than 0 it gets tricky and saves the current variables and arrays, makes the move then calls the move generation code again to predict the human's move and subtracts its score from the move's score. Further lookahead levels keep swapping sides adding and subtracting the score. When done "playing" tests it puts the variables back and jumps back into the same move code it was calling to perform the lookahead, a concept known as "recursion". This is actually a mild example since while looking ahead lookahead is disabled, otherwise an array, tricky code and a lot of execution time would be needed to track all the nested possibilities. Surprisingly the compiler let be jump out of and back into DO loops and even save and restore the DO loop index variables to reuse the same code, when I tried this trick in BASIC I had to branch to different FOR/NEXT statements.

A tricky part was figuring out what to do with tie scores, since the scan proceeds from 1,1 to 8,8 if it just ignored or always replaced moves with tie scores it tends to choose moves to one side or the other. To avoid this it uses the score, the move's raw gain and a counter which is incremented for each new computer move, all added together and AND'd with 1 to produce a tie-break bit. The counter also helps randomize additional games, the first run is always deterministic (there are no clocks or other mechanisms available to provide inherent randomness), after that anything goes. Within each move block a static tie-break isn't desireable since that would prevent ties in the middle from being selected, too much randomness is just as bad as it tends to favor ties to one side. Instead the move's piece gain is used, sometimes it's the same, sometimes it's different (at least when lookahead is in effect). A better way would have been to save all ties and select each with equal probability but that's too much logic for this hack, gotta draw the line somewhere.

For those not familiar with old-style FORTRAN, these IF statements evaluate an expression then do a two or three way branch. If two destination lines are specified, the first is followed if the expression is less than 0 otherwise the second branch is followed. Three numbers are used to specify less than 0, 0, or greater than 0. These IFs never just drop through. One nice thing, if an expression should never be less than 0 the first number can be a branch to some error code to indicate the bug.

Other than PRT to print prompt text, there are no conventional subroutines in this program. For one thing HP FORTRAN permits only 5 "modules" maximum in each source file and the resulting relocateable "object" files give no clue as to how many modules they contain unless hex-edited to look, when linking an additional "continue" has to be given for each additional module as if it were a separate tape. This can be handled by my build script maker but it's messy, if using subroutines I'd be inclined to place each one in a separate source file. The primary reason I decided against using subroutines relates to how HP21xx minicomputers call subroutines, they store the return address inside the code that's being called. This prevents any form of recursion using conventional subroutines, recalling the code overwrites the previous return address and it just goes into an endless loop. However the language has a multiway branch in the form of GO TO (line1,line2,etc),variable. If the variable contains 1 then it branches to line1 etc. Problem solved, lets me recurse all I want without cursing. Convulted perhaps but very easy to code for, just set the LCTLx variable and add the "return" line to the final branch list.

Recursing While Recursing

Limiting recursion to one level makes for fast game play and simple code, but not much strength. If the player doesn't choose the moves it thinks will be chosen then its calculations will be misleading in some way, possibly cancelling out an otherwise good move. Obvious losses are detected, but its feeble attempts at setting up gains are easily thwarted by human lookahead. To make it play better requires true recursion - when looking ahead it looks ahead which possibly also looks ahead, maximum depth has to be controlled to prevent runaway recursion.

At first this seemed like a very difficult problem but the solution was fairly easy - all the variables used to save the current state are arrays in this version, one dimension for each level allowed. This includes the board and weight saves, since this FORTRAN supports only 2 dimensional arrays the third dimension is faked using a multiplied offset. An array was added to hold the return "addresses" for successive calls to the move generation code, and the actual lookahead code itself where it swaps sides, plays the human move, swaps again to play the computer response etc had to be recoded a bit to permit reversing the roles so both sides could use. Also inserted a GAIN=GAIN+1 at line 3022 for an exact gain count, not sure if it makes any difference but seemed to make it stronger. The code includes debugging functions, if an error occurs it indicates the line before the IF that detected the bad value.

Huge numbers of calculations are needed to recurse in this mannor, and it can get quite slow if running on real hardware. By default the program looks 1 move ahead and 2 levels maximum, and takes many seconds to come up with a move on real hardware. The arrays are dimensioned for a maximum of 3 levels, which would take an impractically long time to run on real hardware but not too bad under simulation with the throttle setting disabled for maximum speed. The play level prompt now prompts for recursion level in addition to the existing number of moves to look ahead. I since figured out how to suppress the newline when printing without resorting to machine code, so the code no longer requires the PRT assembly subroutine. This version also has variables for the logical units to make it easier to port to other platforms.

FTN,B,L,A
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
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 2, 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$

It's not too big as programs go... a 32KW HP21xx can run FORTRAN programs much larger than this, but making it go much faster will probably require implementing the flip and computer move generation parts in machine code. An example of this is in the oth2src.txt file in the hpgames.zip file.

Printing without a CRLF

Sometimes something seems impossible, but in fact is simply not mentioned in the docs because it's a feature of another subsystem, in this case the BCS library. I was playing around with HP Algol and noticed one of the print examples in its docs ended with "_", and I also knew Algol could print without a CRLF because of an old Chess game.. hmm.. crafted up a little Algol program that prompted for a string and printed it back, sure enough a "_" at the end of a print string suppressed the CRLF. Algol's print formatting is practically identical to FORTRAN formatting.. hmm.. sure enough the trick works for HP FORTRAN too. Excellent! Doing it with machine code was educational but not necessary, all I had to do was simply say "MOVE: _". Apparently there isn't a standardized way to do this, but specifying strings as "output",$ works for some versions of Fortran. The F2C utility can convert this Reversi-playing program to PC-compatible C code with only minor editing - comment the beginning FTN and ending END$ lines, make LUR=5, and change all instances of _" to ",$ to supress newlines (see the revrsi.txt file in the reversi.zip file for compile details). Newer versions of Fortran use "string",advance="no" to suppress newlines.


Last modified June 14, 2010
GO TO the HP Games Page.