*
* Reversi (Othello) for the Signetics S2650
*
* Adapted from the BASIC program published in the article:
* 
* "Programming Strategies in the Game of Reversi"
* Maggs, Peter B.
* BYTE, November 1979, pp. 66-79.
*
* S2650 Version:
*
* Author: Chris Burrows
* v1.0 May 1981
* v2.0 Nov 2008
*
* (c) 1981-2008 Chris Burrows
*
* CFB Software
* http://www.cfbsoftware.com
*
Z      EQU       0
P      EQU       1
N      EQU       2
EQ     EQU       0
GT     EQU       1
LT     EQU       2
UN     EQU       3
LCOM   EQU       02H
WC     EQU       08H
RS     EQU       10H
NEG1   EQU       0FFH
F      EQU	0         ; False
T	EQU	1         ; True
W	EQU	1         ; White
B	EQU	NEG1      ; Black
*
       ORG       0000H
*
PBUG   DB        0C4H
       DB        04H
       DB        40H
       DS        0440H-3,0
MAIN   BCTA,UN   OTH1
*
* Global Variables
*
brda   DS        100,0     ; For saving board
brdb   DS        100,0     ; Board
brdc   DS        100,0     ; For saving board
brde   DS        100,0     ; Board with square values
rpya   DS        2,0       ; DP best reply to best play
rpyb   DS        2,0       ; DP best reply to current play
rpyc   DS        2,0       ; DP opponent's current reply
plyr   DS        1,0       ; Colour of current mover
ok     DS        1,0       ; Boolean value: 1: true, 0: False
svpa   DS        1,0       ; Save play
svpb   DS        1,0       ; Save play
blok   DS        1,0       ; Count of blocked plays
*
* Monitor Routines
*
* Put the addresses of your monitor 
* routines here.
*
* CHIN - Reads 1 ASCII character into R0
* COUT - Writes 1 ASCII character from R0
* CRLF - Writes Carriage Return, Line Feed
*
* Registers R1, R2, R3 of register bank #0 
* must be unchanged by the calls
*
* Calls to your routines are effected by
* indirect subroutine branches via these
* addresses
*
CHIN   DW        0286H
COUT   DW        02B4H
CRLF   DW        008AH
*
* Data values
*
piec   DB        'B','.','W'    ; Data for board display
*
dist   DB          1, 11,  10   ; Distance to next square
       DB          9, -1, -11
       DB        -10, -9,   0
*
valu   DB        0,   0,   0,   0,   0	; Weighting
       DB        0,   0,   0,   0,   0
       DB        0, 127, -30,  10,   5   
       DB        5,  10, -30, 127,   0
       DB        0, -30, -40,   2,   2   
       DB        2,   2, -40, -30,   0
       DB        0,  10,   2,   5,   1   
       DB        1,   5,   2,  10,   0
       DB        0,   5,   2,   1,   1   
       DB        1,   1,   2,   5,   0
       DB        0,   5,   2,   1,   1   
       DB        1,   1,   2,   5,   0
       DB        0,  10,   2,   5,   1   
       DB        1,   5,   2,  10,   0
       DB        0, -30, -40,   2,   2   
       DB        2,   2, -40, -30,   0
       DB        0, 127, -30,  10,   5   
       DB        5,  10, -30, 127,   0
       DB        0,   0,   0,   0,   0   
       DB        0,   0,   0,   0,   0
mbas   DB        'Play again?'
       DB        0
msg1   DB        'Black '
       DB        -1
msg2   DB        'White '
       DB        -1
msg3   DB        'has no play - '
       DB        'misses turn'   
       DB        0
msg4   DB        'Illegal move'
       DB        0
msg5   DB        'to move (Row,Col) '
       DB        -1
msg6   DB        'has '
       DB        -1
msg7   DB        'End of game'
       DB        0
msg8   DB        ' 12345678'
       DB        0
*
* Main Program
*
OTH1   BSTA,UN   INIT      ; Initialise
OTH2   BSTA,UN   DISP      ; Display board
       BSTA,UN   VALD      ; Check for valid play
       LODA,R0	ok        ; If TRUE then OT10
       BCTA,T 	OT10
       LODA,R0   blok      ; blok := blok + 1
       ADDI,R0   1
       STRA,R0   blok
       COMI,R0   2         ; If blok < 2 then OTH8
       BCTA,LT   OTH8
OT2A  LODI,R0   msg7-mbas
       BSTA,UN   MESS      ; 'End of game'
       EORZ	R0
       STRZ	R1        ; n := 0
       STRZ	R2        ; j := 0
       LODI,R3   11        ; FOR i := 11 TO 88 DO
OTH3   COMI,R3   88        
       BCTR,GT   OTH6
       LODA,R0   brdb,R3   ; IF brdb[i] = -1 THEN OTH4
       BCTR,N  	OTH4
       COMI,R0   1         ; IF brdb[i] # 1 THEN OTH5
       BCFR,EQ   OTH5
       ADDI,R2   1         ; INC(j)
       BCTR,UN   OTH5
OTH4   ADDI,R1   1         ; INC(n)
OTH5   BIRR,R3   OTH3      ; END FOR
OTH6   LODI,R0   msg1-mbas ; "Black "
       BSTA,UN   MESS      
       LODZ      R1        ; Write("Has ", n)
       BSTA,UN   PUTI
       LODI,R0   msg2-mbas ; "White "
       BSTA,UN   MESS
       LODZ      R2        ; Write("Has ", j)
       BSTA,UN   PUTI
       LODI,R0   mbas-mbas ; "Play again?"
       BSTA,UN   MESS
       BSTA,UN   ECHO      ; Read(reply)
       COMI,R0   'Y'       ; IF 'Y' THEN OTH1
       BCTA,EQ   OTH1
       BCTA,UN   PBUG      ; ELSE RETURN TO PipBug
OTH8   BSTA,UN   *CRLF     ; WriteLn
       LODA,R0   plyr      ; IF plyr = white THEN OTH9
       BCTR,W    OTH9     
       LODI,R0   msg1-mbas ; "Black "
       BSTA,UN   MESS
       BCTR,UN   OT9A      ; GOTO OT9A
OTH9   LODI,R0   msg2-mbas ; "White "
       BSTA,UN   MESS
OT9A   LODI,R0   msg3-mbas ; "has no play - misses turn"
       BSTA,UN   MESS
       BCTR,UN   OT18
OT10   EORZ      R0        ; blok := 0
       STRA,R0   blok
       BSTA,UN   GTPL      ; Get a play
       BRNR,R3   OT13      ; IF play # 0 THEN OT13
OT12   BSTA,UN   CHCK      ; Check play
OT13   COMI,R3   99        ; 99 = Terminate game
	BCTA,EQ	OT2A
       COMI,R3   11        ; IF play < 11 THEN OT16
       BCTR,LT   OT16
       COMI,R3   88        ; IF play > 88 THEN OT16
       BCTR,GT   OT16
OT15   BSTA,UN   MKPL      ; Make a play
       LODA,R0   ok        ; IF ok THEN OT18
       BCTR,T 	OT18
OT16   LODI,R0   msg4-mbas ; "Illegal play"
       BSTA,UN   MESS
       BCTA,UN   OTH2      ; GOTO OTH2
OT18   EORZ      R0        ; plyr := -plyr
       SUBA,R0   plyr
       STRA,R0   plyr
       LODA,R0   brde,R3   ; IF brde[play] = 127 THEN 
       COMI,R0   127
       BSTA,EQ   AJCV      ; adjust corner values
       BCTA,UN   OTH2      ; GOTO OTH2
*
* Subroutine GTPL - Get a play
*
GTPL	LODA,R0	plyr	; Get player colour
	BCTR,W    GTP1
	LODI,R0	msg1-mbas	; "black"
	BSTA,UN	MESS
	BCTR,UN	GTP2
GTP1	LODI,R0   msg2-mbas	; "white"
	BSTA,UN	MESS
GTP2	LODI,R0   msg5-mbas
       BSTA,UN   MESS
       BSTA,UN	GETI	; Read(Row)
	STRZ	R3
	BSTA,UN	GETI	; Read(Column)
	STRZ	R2
	BSTA,UN	*CRLF	; WriteLn
	RRL,R3		; R3 := Row * 10 + Column
	LODZ	R3
	RRL,R3
	RRL,R3
	ADDZ	R3
	ADDZ	R2
	STRZ	R3
	RETC,UN		; RETURN
*
* Subroutine VALD - Validate a move
*
VALD	LODI,R0	T	; ok := TRUE
	STRA,R0	ok
	LODI,R3	11	; play := 11
VAL1	LODA,R0	brdb,R3	; IF brdb[play] # 0 THEN VAL5
	BRNR,R0	VAL5
	LODI,R1	0	; n := 0
VAL2	LODA,R0	dist,R1	; j := dist[n]
	STRR,R0	j
	ADDZ	R3	; IF (brdb[play+j]+plyr) # 0 
                           ; THEN VAL4
	LODA,R0	brdb,R0
	ADDA,R0	plyr
	BRNR,R0	VAL4
	LODR,R0	j	; k := play + 2*j
	ADDZ	R0
	ADDZ	R3
VAL3	STRA,R0	k
	LODA,R0	brdb,R0	; IF brdb[k] = 0 THEN VAL4
	BCTR,Z	VAL4
	COMI,R0	2	; IF brdb[k] = 2 THEN VAL4
	BCTR,EQ	VAL4
	COMA,R0	plyr	; IF brdb[k] = plyr THEN VAL6
	BCTR,EQ	VAL6
	LODR,R0	k	; INC(k, j)
	ADDR,R0	j
	BCTR,UN	VAL3	; GOTO VAL3
VAL4	ADDI,R1	1	; INC(n)
	COMI,R1	8	; IF n < 8 THEN VAL2
	BCTR,LT	VAL2
VAL5	ADDI,R3	1	; INC(play)
	COMI,R3	89	; IF play < 89 THEN VAL1
	BCTR,LT	VAL1
	EORZ	R0
	STRA,R0	ok	; ok := FALSE
VAL6	RETC,UN		; RETURN
*
j	DB	0
k	DB	0
*
* Subroutine MKPL - Make a Play
*
MKPL   EORZ      R0        ; ok := FALSE
       STRA,R0   ok
       LODA,R0   brdb,R3   ; IF brdb[play] # 0 THEN MKP7
       BRNA,R0   MKP7
       LODI,R1   0         ; n := 0
MKP2   LODA,R0   dist,R1   ; j := dist[n]
       STRR,R0   j
       ADDZ      R3        ; IF (brdb[play+j]+plyr) # 0 
       LODA,R0   brdb,R0
       ADDA,R0   plyr
       BRNR,R0   MKP6      ; ... THEN MKP6
       LODR,R0   j         ; k := play+2*j
       ADDZ      R0
       ADDZ      R3
MKP3   STRR,R0   k
       LODA,R0   brdb,R0   ; IF brdb[k] = 0 THEN MKP6
       BCTR,Z    MKP6
       COMI,R0   2         ; IF brdb[k] = 2 THEN MKP6
       BCTR,EQ   MKP6
       COMA,R0   plyr      ; IF brdb[k] = plyr THEN MKP4
       BCTR,EQ   MKP4
       LODR,R0   k         ; INC(k, j)
       ADDR,R0   j
       BCTR,UN   MKP3
MKP4   LODI,R0   T         ; ok := TRUE
       STRA,R0   ok
       LODZ      R3        ; l := play
       STRZ      R2
       LODA,R0   plyr
MKP5   COMA,R2   k         ; IF l = k THEN MKP6
       BCTR,EQ   MKP6
       STRA,R0   brdb,R2   ; brdb[l] := plyr
       ADDA,R2   j         ; INC(l, j)
       BCTR,UN   MKP5      ; GOTO MKP5
MKP6   ADDI,R1   1         ; INC(n)
       COMI,R1   8         ; IF n < 8 THEN MKP2
       BCTA,LT   MKP2
MKP7   RETC,UN             ; RETURN
*
* Subroutine Check - Check computer's plays
*
CHCK   LODI,R0   1FH       ; Large +ve 16-bit number
       STRA,R0   rpya
       LODI,R0   0FFH      
       STRA,R0   rpya+1
       LODI,R3   11        ; FOR i := 11 TO 88 DO
CHC1   COMI,R3   88
       BCTR,GT   CHC2
       LODA,R0   brdb,R3   ; brdc[i] := brdb[i]
       STRA,R0   brdc,R3
       BIRR,R3   CHC1      ; NEXT i
CHC2   LODI,R3   11        ; play := 11
CHC3   BSTA,UN   MKPL      ; Make a play
       LODA,R0   ok        ; IF ~ok THEN CHC5
       BCTR,F 	CHC5
       BSTR,UN   CHOP      ; Check opponent's replies
       PPSL      RS        ; IF rpyc > rpya THEN CH3A
       LODA,R1   rpyc
       LODA,R0   rpyc+1
       LODA,R3   rpya
       LODA,R2   rpya+1
       BSTA,UN   DCOM
       BCTR,GT   CH3A
       PPSL      RS        ; rpya := rpyc
       STRA,R1   rpya
       STRA,R0   rpya+1
       CPSL      RS
       LODA,R0   svpa      ; svpb := svpa
       STRA,R0   svpb
CH3A   LODI,R1   11        ; FOR i := 11 TO 88 DO
CHC4   COMI,R1   88
       BCTR,GT   CHC5
       LODA,R0   brdc,R1   ; brdb := brdc
       STRA,R0   brdb,R1
       BIRR,R1   CHC4      ; NEXT i
CHC5   ADDI,R3   1         ; INC(play)
       COMI,R3   89        ; IF play < 89 THEN CHC3
       BCTA,LT   CHC3
       LODA,R3   svpb      ; play := svpb
       RETC,UN             ; RETURN
*
* Subroutine CHOP - Check opponent's replies
*
CHOP   LODI,R0   0F0H      ; rpyc := 0F000H (Large -ve number)
       STRA,R0   rpyc
       EORZ      R0
       STRA,R0   rpyc+1
       LODI,R1   11        ; FOR i := 11 TO 88 DO
CHO1   COMI,R1   88
       BCTR,GT   CHO2
       LODA,R0   brdb,R1   ; brda[i] := brdb[i]
       STRA,R0   brda,R1
       BIRR,R1   CHO1      ; NEXT 7
CHO2   EORZ      R0        ; plyr := -plyr
       SUBA,R0   plyr
       STRA,R0   plyr
       STRA,R3   svpa      ; svpa := play
       LODI,R3   11        ; play := 11
CHO3   BSTA,UN   MKPL      ; Make a play
       LODA,R0   ok        ; IF ~ok THEN CHO6
       BCTA,F 	CHO6
       BSTA,UN   EVAL      ; Evaluate the move
       PPSL      RS        ; IF rpyb < rpya THEN CHO4
       LODA,R1    rpyb
       LODA,R0   rpyb+1
       LODA,R3   rpya
       LODA,R2   rpya+1
       BSTA,UN	DCOM
       BCTR,LT   CHO4
       PPSL      RS        ; rpyc := rpyb
       STRA,R1   rpyc
       STRA,R0   rpyc+1
       CPSL      RS
       BCTR,UN   CHO7      ; GOTO CHO7
CHO4   PPSL      RS        
       LODA,R3   rpyc
       LODA,R2   rpyc+1
       BSTA,UN   DCOM
       BCTR,LT   CH4A
       PPSL      RS        ; rpyc := rpyb
       STRA,R1   rpyc
       STRA,R0   rpyc+1
       CPSL      RS
CH4A   LODI,R1   11        ; FOR i := 11 TO 88 DO
CHO5   COMI,R1   88
       BCTR,GT   CHO6
       LODA,R0   brda,R1   ; brdb[i] := brda[i]
       STRA,R0   brdb,R1
       BIRR,R1   CHO5      ; NEXT i
CHO6   ADDI,R3   1         ; INC(play)
       COMI,R3   89        ; IF play < 89 THEN CHO3
       BCTA,LT   CHO3
CHO7   LODA,R3   svpa      ; play := svpa
       EORZ      R0        ; plyr := -plyr
       SUBA,R0   plyr
       STRA,R0   plyr
       RETC,UN             ; RETURN
*
* Subroutine AJCV - Adjust corner values
*
AJCV   LODI,R0   5
       COMI,R3   11
       BCFR,EQ   AJC1
       STRA,R0   brde+12
       STRA,R0   brde+21
       STRA,R0   brde+22
AJC1   COMI,R3   18
       BCFR,EQ   AJC2
       STRA,R0   brde+17
       STRA,R0   brde+27
       STRA,R0   brde+28
AJC2   COMI,R3   81
       BCFR,EQ   AJC3
       STRA,R0   brde+71
       STRA,R0   brde+72
       STRA,R0   brde+82
AJC3   COMI,R3   88
       BCFR,EQ   AJC4
       STRA,R0   brde+77
       STRA,R0   brde+78
       STRA,R0   brde+87
AJC4   RETC,UN             ; RETURN
*
* Subroutine INIT - Initialise the board
*
INIT   CPSL	RS	; Ensure register bank0 is used
	EORZ      R0
       STRA,R0   blok      ; blok := 0
       LODI,R1   100       ; i := 100, REPEAT
INT1   LODA,R0   valu,R1,- ; DEC(i)
       STRA,R0   brde,R1   ; brde[i] := valu[i]
       EORZ      R0        ; brdb[i] := 0
       STRA,R0   brdb,R1
       BRNR,R1   INT1      ; UNTIL i = 0
       LODI,R1   NEG1      ; i := -1
       LODI,R2   0         ; FOR j := 0 TO 9 DO
INT2   COMI,R2   9
       BCTR,GT   INT3
       LODI,R0   2         ; brdb[i] := 2
       STRA,R0   brdb,R2
       LODZ      R2        ; k := j + 90
       ADDI,R0   90
       STRZ	R3
       LODI,R0   2
       STRA,R0   brdb,R3   ; brdb[k] := 2
       ADDI,R1   1         ; INC(i)
       STRA,R0   brdb,R1   ; brdb[i] := 2
       ADDI,R1   9         ; INC(i, 9)
       STRA,R0   brdb,R1   ; brdb[i] := 2
       BIRR,R2   INT2      ; NEXT j
INT3   LODI,R0   B
       STRA,R0   brdb+44   ; brdb[44] := black
       STRA,R0   brdb+55   ; brdb[55] := black
       LODI,R0   W
       STRA,R0   brdb+45   ; brdb[45] := white
       STRA,R0   brdb+54   ; brdb[54] := white
       LODI,R0   B         ; plyr := black
       STRA,R0   plyr
       RETC,UN             ; RETURN
*
* Subroutine DCOM - Compare R1/R0, R3/R2
*
DCOM   PPSL      RS
       STRR,R3   TEMP      ; Compare high bytes
       COMR,R1   TEMP
       BCFR,EQ   DCO1      ; If equal, compare absolute value
       PPSL      LCOM      ; of low bytes
       COMZ      R2
DCO1   CPSL      RS+LCOM
       RETC,UN             ; RETURN
*
TEMP   DB        0
*
*
* Subroutine ECHO - Echo a character,
*                   Return it in R0
*
ECHO   BSTA,UN   *CHIN     ; Read(CHAR)
       STRR,R0   CHAR
       BSTA,UN   *COUT
       LODR,R0   CHAR
       RETC,UN             ; RETURN R0 := CHAR
*
CHAR   DB        0
*
*
* Subroutine MESS - Print a message
*
MESS   STRR,R0   MPTR      ; MPTR+mbas = Address of 
       LODA,R0   mbas,R0   ; start of message
       BCTR,Z    MES1      ; Zero terminator gives CRLF
       BCTR,LT	MES2      ; Negative terminator, same line
       BSTA,UN   *COUT
       LODR,R0	MPTR
       BIRR,R0	MESS
MES1	BSTA,UN	*CRLF
MES2	RETC,UN		; RETURN
*
MPTR	DB	0
*
* Subroutine PUTI - Write a 2-digit integer
*
PUTI	STRZ	R3	; R3 := Dividend
	LODI,R0	msg6-mbas	; Write('Has ')
	BSTA,UN	MESS
	EORZ	R0	; Initialise tens
PUT1	COMI,R3	10	; Divide integer by 10
	BCTR,LT	PUT2
	SUBI,R3	10
	BIRR,R0	PUT1
PUT2	ADDI,R0	'0'	; Convert to ASCII
	BSTA,UN	*COUT	; Write tens digit
	LODZ      R3
	ADDI,R0	'0'	; Convert to ASCII
	BSTA,UN	*COUT	; Write units digit
	BSTA,UN	*CRLF	; WriteLn
	RETC,UN		; RETURN
*
* Subroutine GETI - Read a 1-digit integer
*
GETI	BSTA,UN	ECHO	; Echo input character
	SUBI,R0	'0'	; Convert to integer
	RETC,UN		; RETURN
*
* Subroutine EVAL - Evaluate the move
*
EVAL	EORZ	R0	; rpyb := 0
	STRA,R0	rpyb
	STRA,R0	rpyb+1
	LODI,R1	11	; i := 11
EVA1	COMI,R1	88	; IF i > 88 THEN EVA4
	BCTR,GT	EVA4
	LODA,R0	brdb,R1	; IF brdb[i] = 0 THEN EVA3
	BCTR,Z	EVA3
	COMA,R0	plyr	; IF brdb[i] = plyr THEN EVA2
	BCTR,EQ	EVA2
	EORZ	R0	; rpyb := rpyb - brde[i]
	SUBA,R0	brde,R1
	BSTR,UN	DADD
	BCTR,UN	EVA3	; GOTO EVA3
EVA2	LODA,R0	brde,R1	; rpyb := rpyb + brde[i]
	BSTR,UN	DADD
	PPSL	RS	; IF rpyb > rpya THEN EVA4
	LODA,R3	rpya
	LODA,R2	rpya+1
	BSTA,UN	DCOM
	BCTR,GT	EVA4
EVA3	BIRR,R1	EVA1	; INC(i); GOTO EVA1
EVA4	RETC,UN		; RETURN
*
* Subroutine DADD - DP Addition, 
*    rpyb := rpyb + R0
*    R1R0 := rpyb
*
DADD	PPSL	RS	; Upper register bank
	LODI,R1	0
	COMZ	R1	; Is R0 -ve?
	BCFR,LT	DAD1
	LODI,R1	0FFH	; Yes, extend sign bit into R1
DAD1	ADDA,R0	rpyb+1	; Sum low bytes
	PPSL	WC	; Then, with carry,
	ADDA,R1	rpyb	; sum high bytes
	STRA,R1	rpyb
	STRA,R1	rpyb+1
	CPSL	RS+WC	; Clear flags
	RETC,UN		; RETURN
*
* Subroutine DISP - Display the board
*
DISP   BSTA,UN   *CRLF     ; WriteLn
       LODI,R0   msg8-mbas ; Write(' 12345678')
	BSTA,UN	MESS
	LODI,R1	10	; i := 10
	LODI,R0	'0'	; RowNo := '0'
DIS1	ADDI,R0	1	; INC(RowNo)
	STRR,R0	rown
	BSTA,UN	*COUT	; Write(RowNo)
	LODI,R2	8	; FOR j := 8 TO 0 BY -1 DO
DIS2	LODA,R0	brdb,R1,+	; INC(i); VAL := brdb[i]
	LODA,R0	piec,R0,+	; Write(piec[val+1])
	BSTA,UN	*COUT
	COMI,R1	88	; IF i = 88 THEN DIS3
	BCTR,EQ	DIS3
	BDRR,R2	DIS2	; NEXT j
	BSTA,UN	*CRLF	; WriteLn
	ADDI,R1	2	; INC(i, 2)
	LODR,R0	rown
	BCTR,UN	DIS1	; GOTO DIS1
DIS3	BSTA,UN	*CRLF	; WriteLn
	RETC,UN		; RETURN
*
rown	DB	0
*
END
