Palaiologos/langsmoke
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
06c5b26b5f
langsmoke/ref_6502

1244 lines
31 KiB
Plaintext
Raw Normal View History

stuff
2023-11-12 13:49:57 +00:00
;
; 6551 I/O Port Addresses
;
ACIADat = $7F70
ACIASta = $7F71
ACIACmd = $7F72
ACIACtl = $7F73
;
; page zero variables
;
BOARD = $50
BK = $60
PIECE = $B0
SQUARE = $B1
SP2 = $B2
SP1 = $B3
INCHEK = $B4
STATE = $B5
MOVEN = $B6
REV = $B7
OMOVE = $DC
WCAP0 = $DD
COUNT = $DE
BCAP2 = $DE
WCAP2 = $DF
BCAP1 = $E0
WCAP1 = $E1
BCAP0 = $E2
MOB = $E3
MAXC = $E4
CC = $E5
PCAP = $E6
BMOB = $E3
BMAXC = $E4
BMCC = $E5 ; was BCC (TASS doesn't like it as a label)
BMAXP = $E6
XMAXC = $E8
WMOB = $EB
WMAXC = $EC
WCC = $ED
WMAXP = $EE
PMOB = $EF
PMAXC = $F0
PCC = $F1
PCP = $F2
OLDKY = $F3
BESTP = $FB
BESTV = $FA
BESTM = $F9
DIS1 = $FB
DIS2 = $FA
DIS3 = $F9
temp = $FC
;
;
;
*=$1000 ; load into RAM @ $1000-$15FF
LDA #$00 ; REVERSE TOGGLE
STA REV
JSR Init_6551
CHESS CLD ; INITIALIZE
LDX #$FF ; TWO STACKS
TXS
LDX #$C8
STX SP2
;
; ROUTINES TO LIGHT LED
; DISPLAY AND GET KEY
; FROM KEYBOARD
;
OUT JSR pout ; DISPLAY AND
JSR KIN ; GET INPUT *** my routine waits for a keypress
; CMP OLDKY ; KEY IN ACC *** no need to debounce
; BEQ OUT ; (DEBOUNCE)
; STA OLDKY
;
CMP #$43 ; [C]
BNE NOSET ; SET UP
LDX #$1F ; BOARD
WHSET LDA SETW,X ; FROM
STA BOARD,X ; SETW
DEX
BPL WHSET
LDX #$1B ; *ADDED
STX OMOVE ; INITS TO $FF
LDA #$CC ; Display CCC
BNE CLDSP
;
NOSET CMP #$45 ; [E]
BNE NOREV ; REVERSE
JSR REVERSE ; BOARD IS
SEC
LDA #$01
SBC REV
STA REV ; TOGGLE REV FLAG
LDA #$EE ; IS
BNE CLDSP
;
NOREV CMP #$40 ; [P]
BNE NOGO ; PLAY CHESS
JSR GO
CLDSP STA DIS1 ; DISPLAY
STA DIS2 ; ACROSS
STA DIS3 ; DISPLAY
BNE CHESS
;
NOGO CMP #$0D ; [Enter]
BNE NOMV ; MOVE MAN
JSR MOVE ; AS ENTERED
JMP DISP
NOMV CMP #$41 ; [Q] ***Added to allow game exit***
BEQ DONE ; quit the game, exit back to system.
JMP INPUT ; process move
DONE JMP $FF00 ; *** MUST set this to YOUR OS starting address
;
; THE ROUTINE JANUS DIRECTS THE
; ANALYSIS BY DETERMINING WHAT
; SHOULD OCCUR AFTER EACH MOVE
; GENERATED BY GNM
;
;
;
JANUS LDX STATE
BMI NOCOUNT
;
; THIS ROUTINE COUNTS OCCURRENCES
; IT DEPENDS UPON STATE TO INDEX
; THE CORRECT COUNTERS
;
COUNTS LDA PIECE
BEQ OVER ; IF STATE=8
CPX #$08 ; DO NOT COUNT
BNE OVER ; BLK MAX CAP
CMP BMAXP ; MOVES FOR
BEQ XRT ; WHITE
;
OVER INC MOB,X ; MOBILITY
CMP #$01 ; + QUEEN
BNE NOQ ; FOR TWO
INC MOB,X
;
NOQ BVC NOCAP
LDY #$0F ; CALCULATE
LDA SQUARE ; POINTS
ELOOP CMP BK,Y ; CAPTURED
BEQ FOUN ; BY THIS
DEY ; MOVE
BPL ELOOP
FOUN LDA POINTS,Y
CMP MAXC,X
BCC LESS ; SAVE IF
STY PCAP,X ; BEST THIS
STA MAXC,X ; STATE
;
LESS CLC
PHP ; ADD TO
ADC CC,X ; CAPTURE
STA CC,X ; COUNTS
PLP
;
NOCAP CPX #$04
BEQ ON4
BMI TREE ;(=00 ONLY)
XRT RTS
;
; GENERATE FURTHER MOVES FOR COUNT
; AND ANALYSIS
;
ON4 LDA XMAXC ; SAVE ACTUAL
STA WCAP0 ; CAPTURE
LDA #$00 ; STATE=0
STA STATE
JSR MOVE ; GENERATE
JSR REVERSE ; IMMEDIATE
JSR GNMZ ; REPLY MOVES
JSR REVERSE
;
LDA #$08 ; STATE=8
STA STATE ; GENERATE
; JSR OHM ; CONTINUATION
JSR UMOVE ; MOVES
;
JMP STRATGY ; FINAL EVALUATION
NOCOUNT CPX #$F9
BNE TREE
;
; DETERMINE IF THE KING CAN BE
; TAKEN, USED BY CHKCHK
;
LDA BK ; IS KING
CMP SQUARE ; IN CHECK?
BNE RETJ ; SET INCHEK=0
LDA #$00 ; IF IT IS
STA INCHEK
RETJ RTS
;
; IF A PIECE HAS BEEN CAPTURED BY
; A TRIAL MOVE, GENERATE REPLIES &
; EVALUATE THE EXCHANGE GAIN/LOSS
;
TREE BVC RETJ ; NO CAP
LDY #$07 ; (PIECES)
LDA SQUARE
LOOPX CMP BK,Y
BEQ FOUNX
DEY
BEQ RETJ ; (KING)
BPL LOOPX ; SAVE
FOUNX LDA POINTS,Y ; BEST CAP
CMP BCAP0,X ; AT THIS
BCC NOMAX ; LEVEL
STA BCAP0,X
NOMAX DEC STATE
LDA #$FB ; IF STATE=FB
CMP STATE ; TIME TO TURN
BEQ UPTREE ; AROUND
JSR GENRM ; GENERATE FURTHER
UPTREE INC STATE ; CAPTURES
RTS
;
; THE PLAYER'S MOVE IS INPUT
;
INPUT CMP #$08 ; NOT A LEGAL
BCS ERROR ; SQUARE #
JSR DISMV
DISP LDX #$1F
SEARCH LDA BOARD,X
CMP DIS2
BEQ HERE ; DISPLAY
DEX ; PIECE AT
BPL SEARCH ; FROM
HERE STX DIS1 ; SQUARE
STX PIECE
ERROR JMP CHESS
;
; GENERATE ALL MOVES FOR ONE
; SIDE, CALL JANUS AFTER EACH
; ONE FOR NEXT STE?
;
;
GNMZ LDX #$10 ; CLEAR
GNMX LDA #$00 ; COUNTERS
CLEAR STA COUNT,X
DEX
BPL CLEAR
;
GNM LDA #$10 ; SET UP
STA PIECE ; PIECE
NEWP DEC PIECE ; NEW PIECE
BPL NEX ; ALL DONE?
RTS ; #NAME?
;
NEX JSR RESET ; READY
LDY PIECE ; GET PIECE
LDX #$08
STX MOVEN ; COMMON START
CPY #$08 ; WHAT IS IT?
BPL PAWN ; PAWN
CPY #$06
BPL KNIGHT ; KNIGHT
CPY #$04
BPL BISHOP ; BISHOP
CPY #$01
BEQ QUEEN ; QUEEN
BPL ROOK ; ROOK
;
KING JSR SNGMV ; MUST BE KING!
BNE KING ; MOVES
BEQ NEWP ; 8 TO 1
QUEEN JSR LINE
BNE QUEEN ; MOVES
BEQ NEWP ; 8 TO 1
;
ROOK LDX #$04
STX MOVEN ; MOVES
AGNR JSR LINE ; 4 TO 1
BNE AGNR
BEQ NEWP
;
BISHOP JSR LINE
LDA MOVEN ; MOVES
CMP #$04 ; 8 TO 5
BNE BISHOP
BEQ NEWP
;
KNIGHT LDX #$10
STX MOVEN ; MOVES
AGNN JSR SNGMV ; 16 TO 9
LDA MOVEN
CMP #$08
BNE AGNN
BEQ NEWP
;
PAWN LDX #$06
STX MOVEN
P1 JSR CMOVE ; RIGHT CAP?
BVC P2
BMI P2
JSR JANUS ; YES
P2 JSR RESET
DEC MOVEN ; LEFT CAP?
LDA MOVEN
CMP #$05
BEQ P1
P3 JSR CMOVE ; AHEAD
BVS NEWP ; ILLEGAL
BMI NEWP
JSR JANUS
LDA SQUARE ; GETS TO
AND #$F0 ; 3RD RANK?
CMP #$20
BEQ P3 ; DO DOUBLE
JMP NEWP
;
; CALCULATE SINGLE STEP MOVES
; FOR K,N
;
SNGMV JSR CMOVE ; CALC MOVE
BMI ILL1 ; -IF LEGAL
JSR JANUS ; -EVALUATE
ILL1 JSR RESET
DEC MOVEN
RTS
;
; CALCULATE ALL MOVES DOWN A
; STRAIGHT LINE FOR Q,B,R
;
LINE JSR CMOVE ; CALC MOVE
BCC OVL ; NO CHK
BVC LINE ; NOCAP
OVL BMI ILL ; RETURN
PHP
JSR JANUS ; EVALUATE POSN
PLP
BVC LINE ; NOT A CAP
ILL JSR RESET ; LINE STOPPED
DEC MOVEN ; NEXT DIR
RTS
;
; EXCHANGE SIDES FOR REPLY
; ANALYSIS
;
REVERSE LDX #$0F
ETC SEC
LDY BK,X ; SUBTRACT
LDA #$77 ; POSITION
SBC BOARD,X ; FROM 77
STA BK,X
STY BOARD,X ; AND
SEC
LDA #$77 ; EXCHANGE
SBC BOARD,X ; PIECES
STA BOARD,X
DEX
BPL ETC
RTS
;
; CMOVE CALCULATES THE TO SQUARE
; USING SQUARE AND THE MOVE
; TABLE FLAGS SET AS FOLLOWS:
; N#NAME? MOVE
; V#NAME? (LEGAL UNLESS IN CR)
; C#NAME? BECAUSE OF CHECK
; [MY &THANKS TO JIM BUTTERFIELD
; WHO WROTE THIS MORE EFFICIENT
; VERSION OF CMOVE)
;
CMOVE LDA SQUARE ; GET SQUARE
LDX MOVEN ; MOVE POINTER
CLC
ADC MOVEX,X ; MOVE LIST
STA SQUARE ; NEW POS'N
AND #$88
BNE ILLEGAL ; OFF BOARD
LDA SQUARE
;
LDX #$20
LOOP DEX ; IS TO
BMI NO ; SQUARE
CMP BOARD,X ; OCCUPIED?
BNE LOOP
;
CPX #$10 ; BY SELF?
BMI ILLEGAL
;
LDA #$7F ; MUST BE CAP!
ADC #$01 ; SET V FLAG
BVS SPX ; (JMP)
;
NO CLV ; NO CAPTURE
;
SPX LDA STATE ; SHOULD WE
BMI RETL ; DO THE
CMP #$08 ; CHECK CHECK?
BPL RETL
;
; CHKCHK REVERSES SIDES
; AND LOOKS FOR A KING
; CAPTURE TO INDICATE
; ILLEGAL MOVE BECAUSE OF
; CHECK SINCE THIS IS
; TIME CONSUMING, IT IS NOT
; ALWAYS DONE
;
CHKCHK PHA ; STATE #392
PHP
LDA #$F9
STA STATE ; GENERATE
STA INCHEK ; ALL REPLY
JSR MOVE ; MOVES TO
JSR REVERSE ; SEE IF KING
JSR GNM ; IS IN
JSR RUM ; CHECK
PLP
PLA
STA STATE
LDA INCHEK
BMI RETL ; NO - SAFE
SEC ; YES - IN CHK
LDA #$FF
RTS
;
RETL CLC ; LEGAL
LDA #$00 ; RETURN
RTS
;
ILLEGAL LDA #$FF
CLC ; ILLEGAL
CLV ; RETURN
RTS
;
; REPLACE PIECE ON CORRECT SQUARE
;
RESET LDX PIECE ; GET LOGAT
LDA BOARD,X ; FOR PIECE
STA SQUARE ; FROM BOARD
RTS
;
;
;
GENRM JSR MOVE ; MAKE MOVE
GENR2 JSR REVERSE ; REVERSE BOARD
JSR GNM ; GENERATE MOVES
RUM JSR REVERSE ; REVERSE BACK
;
; ROUTINE TO UNMAKE A MOVE MADE BY
; MOVE
;
UMOVE TSX ; UNMAKE MOVE
STX SP1
LDX SP2 ; EXCHANGE
TXS ; STACKS
PLA ; MOVEN
STA MOVEN
PLA ; CAPTURED
STA PIECE ; PIECE
TAX
PLA ; FROM SQUARE
STA BOARD,X
PLA ; PIECE
TAX
PLA ; TO SOUARE
STA SQUARE
STA BOARD,X
JMP STRV
;
; THIS ROUTINE MOVES PIECE
; TO SQUARE, PARAMETERS
; ARE SAVED IN A STACK TO UNMAKE
; THE MOVE LATER
;
MOVE TSX
STX SP1 ; SWITCH
LDX SP2 ; STACKS
TXS
LDA SQUARE
PHA ; TO SQUARE
TAY
LDX #$1F
CHECK CMP BOARD,X ; CHECK FOR
BEQ TAKE ; CAPTURE
DEX
BPL CHECK
TAKE LDA #$CC
STA BOARD,X
TXA ; CAPTURED
PHA ; PIECE
LDX PIECE
LDA BOARD,X
STY BOARD,X ; FROM
PHA ; SQUARE
TXA
PHA ; PIECE
LDA MOVEN
PHA ; MOVEN
STRV TSX
STX SP2 ; SWITCH
LDX SP1 ; STACKS
TXS ; BACK
RTS
;
; CONTINUATION OF SUB STRATGY
; -CHECKS FOR CHECK OR CHECKMATE
; AND ASSIGNS VALUE TO MOVE
;
CKMATE LDY BMAXC ; CAN BLK CAP
CPX POINTS ; MY KING?
BNE NOCHEK
LDA #$00 ; GULP!
BEQ RETV ; DUMB MOVE!
;
NOCHEK LDX BMOB ; IS BLACK
BNE RETV ; UNABLE TO
LDX WMAXP ; MOVE AND
BNE RETV ; KING IN CH?
LDA #$FF ; YES! MATE
;
RETV LDX #$04 ; RESTORE
STX STATE ; STATE=4
;
; THE VALUE OF THE MOVE (IN ACCU)
; IS COMPARED TO THE BEST MOVE AND
; REPLACES IT IF IT IS BETTER
;
PUSH CMP BESTV ; IS THIS BEST
BCC RETP ; MOVE SO FAR?
BEQ RETP
STA BESTV ; YES!
LDA PIECE ; SAVE IT
STA BESTP
LDA SQUARE
STA BESTM ; FLASH DISPLAY
RETP LDA #"." ; print ... instead of flashing disp
Jmp syschout ; print . and return
;
; MAIN PROGRAM TO PLAY CHESS
; PLAY FROM OPENING OR THINK
;
GO LDX OMOVE ; OPENING?
BMI NOOPEN ; -NO *ADD CHANGE FROM BPL
LDA DIS3 ; -YES WAS
CMP OPNING,X ; OPPONENT'S
BNE END ; MOVE OK?
DEX
LDA OPNING,X ; GET NEXT
STA DIS1 ; CANNED
DEX ; OPENING MOVE
LDA OPNING,X
STA DIS3 ; DISPLAY IT
DEX
STX OMOVE ; MOVE IT
BNE MV2 ; (JMP)
;
END LDA #$FF ; *ADD - STOP CANNED MOVES
STA OMOVE ; FLAG OPENING
NOOPEN LDX #$0C ; FINISHED
STX STATE ; STATE=C
STX BESTV ; CLEAR BESTV
LDX #$14 ; GENERATE P
JSR GNMX ; MOVES
;
LDX #$04 ; STATE=4
STX STATE ; GENERATE AND
JSR GNMZ ; TEST AVAILABLE
;
; MOVES
;
LDX BESTV ; GET BEST MOVE
CPX #$0F ; IF NONE
BCC MATE ; OH OH!
;
MV2 LDX BESTP ; MOVE
LDA BOARD,X ; THE
STA BESTV ; BEST
STX PIECE ; MOVE
LDA BESTM
STA SQUARE ; AND DISPLAY
JSR MOVE ; IT
JMP CHESS
;
MATE LDA #$FF ; RESIGN
RTS ; OR STALEMATE
;
; SUBROUTINE TO ENTER THE
; PLAYER'S MOVE
;
DISMV LDX #$04 ; ROTATE
DROL ASL DIS3 ; KEY
ROL DIS2 ; INTO
DEX ; DISPLAY
BNE DROL ;
ORA DIS3
STA DIS3
STA SQUARE
RTS
;
; THE FOLLOWING SUBROUTINE ASSIGNS
; A VALUE TO THE MOVE UNDER
; CONSIDERATION AND RETURNS IT IN
; THE ACCUMULATOR
;
STRATGY CLC
LDA #$80
ADC WMOB ; PARAMETERS
ADC WMAXC ; WITH WHEIGHT
ADC WCC ; OF O25
ADC WCAP1
ADC WCAP2
SEC
SBC PMAXC
SBC PCC
SBC BCAP0
SBC BCAP1
SBC BCAP2
SBC PMOB
SBC BMOB
BCS POS ; UNDERFLOW
LDA #$00 ; PREVENTION
POS LSR
CLC ; **************
ADC #$40
ADC WMAXC ; PARAMETERS
ADC WCC ; WITH WEIGHT
SEC ; OF 05
SBC BMAXC
LSR ; **************
CLC
ADC #$90
ADC WCAP0 ; PARAMETERS
ADC WCAP0 ; WITH WEIGHT
ADC WCAP0 ; OF 10
ADC WCAP0
ADC WCAP1
SEC ; [UNDER OR OVER-
SBC BMAXC ; FLOW MAY OCCUR
SBC BMAXC ; FROM THIS
SBC BMCC ; SECTION]
SBC BMCC
SBC BCAP1
LDX SQUARE ; ***************
CPX #$33
BEQ POSN ; POSITION
CPX #$34 ; BONUS FOR
BEQ POSN ; MOVE TO
CPX #$22 ; CENTRE
BEQ POSN ; OR
CPX #$25 ; OUT OF
BEQ POSN ; BACK RANK
LDX PIECE
BEQ NOPOSN
LDY BOARD,X
CPY #$10
BPL NOPOSN
POSN CLC
ADC #$02
NOPOSN JMP CKMATE ; CONTINUE
;-----------------------------------------------------------------
; The following routines were added to allow text-based board
; display over a standard RS-232 port.
;
POUT jsr pout9 ; print CRLF
jsr pout13 ; print copyright
JSR POUT10 ; print column labels
LDY #$00 ; init board location
JSR POUT5 ; print board horz edge
POUT1 lDA #"|" ; print vert edge
JSR syschout ; PRINT ONE ASCII CHR - SPACE
LDX #$1F
POUT2 TYA ; scan the pieces for a location
match
CMP BOARD,X ; match found?
BEQ POUT4 ; yes; print the piece's color and
type
DEX ; no
BPL POUT2 ; if not the last piece, try again
tya ; empty square
and #$01 ; odd or even column?
sta temp ; save it
tya ; is the row odd or even
lsr ; shift column right 4 spaces
lsr ;
lsr ;
lsr ;
and #$01 ; strip LSB
clc ;
adc temp ; combine row & col to determine
square color
and #$01 ; is board square white or blk?
bne pout25 ; white, print space
lda #"*" ; black, print *
.byte $2c ; used to skip over LDA #$20
POUT25 LDA #$20 ; ASCII space
JSR syschout ; PRINT ONE ASCII CHR - SPACE
JSR syschout ; PRINT ONE ASCII CHR - SPACE
POUT3 INY ;
TYA ; get row number
AND #$08 ; have we completed the row?
BEQ POUT1 ; no, do next column
LDA #"|" ; yes, put the right edge on
JSR syschout ; PRINT ONE ASCII CHR - |
jsr pout12 ; print row number
JSR POUT9 ; print CRLF
JSR POUT5 ; print bottom edge of board
CLC ;
TYA ;
ADC #$08 ; point y to beginning of next row
TAY ;
CPY #$80 ; was that the last row?
BEQ POUT8 ; yes, print the LED values
BNE POUT1 ; no, do new row
POUT4 LDA REV ; print piece's color & type
BEQ POUT41 ;
LDA cpl+16,X ;
BNE POUT42 ;
POUT41 LDA cpl,x ;
POUT42 JSR syschout ;
lda cph,x ;
jsr syschout ;
BNE POUT3 ; branch always
POUT5 TXA ; print "-----...-----"
PHA
LDX #$19
LDA #"-"
POUT6 JSR syschout ; PRINT ONE ASCII CHR - "-"
DEX
BNE POUT6
PLA
TAX
JSR POUT9
RTS
POUT8 jsr pout10 ;
LDA $FB
JSR syshexout ; PRINT 1 BYTE AS 2 HEX CHRS
LDA #$20
JSR syschout ; PRINT ONE ASCII CHR - SPACE
LDA $FA
JSR syshexout ; PRINT 1 BYTE AS 2 HEX CHRS
LDA #$20
JSR syschout ; PRINT ONE ASCII CHR - SPACE
LDA $F9
JSR syshexout ; PRINT 1 BYTE AS 2 HEX CHRS
POUT9 LDA #$0D
JSR syschout ; PRINT ONE ASCII CHR - CR
LDA #$0A
JSR syschout ; PRINT ONE ASCII CHR - LF
RTS
pout10 ldx #$00 ; print the column labels
POUT11 lda #$20 ; 00 01 02 03 ... 07
jsr syschout
txa
jsr syshexout
INX
CPX #$08
BNE POUT11
BEQ POUT9
POUT12 TYA
and #$70
JSR syshexout
rts
Pout13 ldx #$00 ; Print the copyright banner
Pout14 lda banner,x
beq POUT15
jsr syschout
inx
bne POUT14
POUT15 rts
KIN LDA #"?"
JSR syschout ; PRINT ONE ASCII CHR - ?
JSR syskin ; GET A KEYSTROKE FROM SYSTEM
AND #$4F ; MASK 0-7, AND ALPHA'S
RTS
;
; 6551 I/O Support Routines
;
;
Init_6551 lda #$1F ; 19.2K/8/1
sta ACIActl ; control reg
lda #$0B ; N parity/echo off/rx int off/
dtr active low
sta ACIAcmd ; command reg
rts ; done
;
; input chr from ACIA1 (waiting)
;
syskin lda ACIASta ; Serial port status
and #$08 ; is recvr full
beq syskin ; no char to get
Lda ACIAdat ; get chr
RTS ;
;
; output to OutPut Port
;
syschout PHA ; save registers
ACIA_Out1 lda ACIASta ; serial port status
and #$10 ; is tx buffer empty
beq ACIA_Out1 ; no
PLA ; get chr
sta ACIAdat ; put character to Port
RTS ; done
syshexout PHA ; prints AA hex digits
LSR ; MOVE UPPER NIBBLE TO LOWER
LSR ;
LSR ;
LSR ;
JSR PrintDig ;
PLA ;
PrintDig PHY ; prints A hex nibble (low 4 bits)
AND #$0F ;
TAY ;
LDA Hexdigdata,Y ;
PLY ;
jmp syschout ;
Hexdigdata .byte "0123456789ABCDEF"
banner .byte "MicroChess (c) 1996-2002 Peter Jennings,
peterj@benlo.com"
.byte $0d, $0a, $00
cpl .byte "WWWWWWWWWWWWWWWWBBBBBBBBBBBBBBBBWWWWWWWWWWWWWWWW"
cph .byte "KQCCBBRRPPPPPPPPKQCCBBRRPPPPPPPP"
.byte $00
;
; end of added code
;
; BLOCK DATA
*= $1580
SETW .byte $03, $04, $00, $07, $02, $05, $01, $06
.byte $10, $17, $11, $16, $12, $15, $14, $13
.byte $73, $74, $70, $77, $72, $75, $71, $76
.byte $60, $67, $61, $66, $62, $65, $64, $63
MOVEX .byte $00, $F0, $FF, $01, $10, $11, $0F, $EF, $F1
.byte $DF, $E1, $EE, $F2, $12, $0E, $1F, $21
POINTS .byte $0B, $0A, $06, $06, $04, $04, $04, $04
.byte $02, $02, $02, $02, $02, $02, $02, $02
OPNING .byte $99, $25, $0B, $25, $01, $00, $33, $25
.byte $07, $36, $34, $0D, $34, $34, $0E, $52
.byte $25, $0D, $45, $35, $04, $55, $22, $06
.byte $43, $33, $0F, $CC
;
;
; end of file
TMP EQU $6 ; Temporary storage
WEEKDAY:
CPX #3 ; Year starts in March to bypass
BCS MARCH ; leap year problem
DEY ; If Jan or Feb, decrement year
MARCH EOR #$7F ; Invert A so carry works right
CPY #200 ; Carry will be 1 if 22nd century
ADC MTAB-1,X ; A is now day+month offset
STA TMP
TYA ; Get the year
JSR MOD7 ; Do a modulo to prevent overflow
SBC TMP ; Combine with day+month
STA TMP
TYA ; Get the year again
LSR ; Divide it by 4
LSR
CLC ; Add it to y+m+d and fall through
ADC TMP
MOD7 ADC #7 ; Returns (A+3) modulo 7
BCC MOD7 ; for A in 0..255
RTS
MTAB DB 1,5,6,3,1,5,3,0,4,2,6,4 ; Month offsets
R0L EQU $0
R0H EQU $1
R14H EQU $1D
R15L EQU $1E
R15H EQU $1F
SAVE EQU $FF4A
RESTORE EQU $FF3F
ORG $F689
AST 32
JSR SAVE ;PRESERVE 6502 REG CONTENTS
PLA
STA R15L ;INIT SWEET16 PC
PLA ;FROM RETURN
STA R15H ;ADDRESS
SW16B JSR SW16C ;INTERPRET AND EXECUTE
JMP SW16B ;ONE SWEET16 INSTR.
SW16C INC R15L
BNE SW16D ;INCR SWEET16 PC FOR FETCH
INC R15H
SW16D LDA >SET ;COMMON HIGH BYTE FOR ALL ROUTINES
PHA ;PUSH ON STACK FOR RTS
LDY $0
LDA (R15L),Y ;FETCH INSTR
AND $F ;MASK REG SPECIFICATION
ASL ;DOUBLE FOR TWO BYTE REGISTERS
TAX ;TO X REG FOR INDEXING
LSR
EOR (R15L),Y ;NOW HAVE OPCODE
BEQ TOBR ;IF ZERO THEN NON-REG OP
STX R14H ;INDICATE "PRIOR RESULT REG"
LSR
LSR ;OPCODE*2 TO LSB'S
LSR
TAY ;TO Y REG FOR INDEXING
LDA OPTBL-2,Y ;LOW ORDER ADR BYTE
PHA ;ONTO STACK
RTS ;GOTO REG-OP ROUTINE
TOBR INC R15L
BNE TOBR2 ;INCR PC
INC R15H
TOBR2 LDA BRTBL,X ;LOW ORDER ADR BYTE
PHA ;ONTO STACK FOR NON-REG OP
LDA R14H ;"PRIOR RESULT REG" INDEX
LSR ;PREPARE CARRY FOR BC, BNC.
RTS ;GOTO NON-REG OP ROUTINE
RTNZ PLA ;POP RETURN ADDRESS
PLA
JSR RESTORE ;RESTORE 6502 REG CONTENTS
JMP (R15L) ;RETURN TO 6502 CODE VIA PC
SETZ LDA (R15L),Y ;HIGH ORDER BYTE OF CONSTANT
STA R0H,X
DEY
LDA (R15L),Y ;LOW ORDER BYTE OF CONSTANT
STA R0L,X
TYA ;Y REG CONTAINS 1
SEC
ADC R15L ;ADD 2 TO PC
STA R15L
BCC SET2
INC R15H
SET2 RTS
OPTBL DFB SET-1 ;1X
BRTBL DFB RTN-1 ;0
DFB LD-1 ;2X
DFB BR-1 ;1
DFB ST-1 ;3X
DFB BNC-1 ;2
DFB LDAT-1 ;4X
DFB BC-1 ;3
DFB STAT-1 ;5X
DFB BP-1 ;4
DFB LDDAT-1 ;6X
DFB BM-1 ;5
DFB STDAT-1 ;7X
DFB BZ-1 ;6
DFB POP-1 ;8X
DFB BNZ-1 ;7
DFB STPAT-1 ;9X
DFB BM1-1 ;8
DFB ADD-1 ;AX
DFB BNM1-1 ;9
DFB SUB-1 ;BX
DFB BK-1 ;A
DFB POPD-1 ;CX
DFB RS-1 ;B
DFB CPR-1 ;DX
DFB BS-1 ;C
DFB INR-1 ;EX
DFB NUL-1 ;D
DFB DCR-1 ;FX
DFB NUL-1 ;E
DFB NUL-1 ;UNUSED
DFB NUL-1 ;F
* FOLLOWING CODE MUST BE
* CONTAINED ON A SINGLE PAGE!
SET BPL SETZ ;ALWAYS TAKEN
LD LDA R0L,X
BK EQU *-1
STA R0L
LDA R0H,X ;MOVE RX TO R0
STA R0H
RTS
ST LDA R0L
STA R0L,X ;MOVE R0 TO RX
LDA R0H
STA R0H,X
RTS
STAT LDA R0L
STAT2 STA (R0L,X) ;STORE BYTE INDIRECT
LDY $0
STAT3 STY R14H ;INDICATE R0 IS RESULT NEG
INR INC R0L,X
BNE INR2 ;INCR RX
INC R0H,X
INR2 RTS
LDAT LDA (R0L,X) ;LOAD INDIRECT (RX)
STA R0L ;TO R0
LDY $0
STY R0H ;ZERO HIGH ORDER R0 BYTE
BEQ STAT3 ;ALWAYS TAKEN
POP LDY $0 ;HIGH ORDER BYTE = 0
BEQ POP2 ;ALWAYS TAKEN
POPD JSR DCR ;DECR RX
LDA (R0L,X) ;POP HIGH ORDER BYTE @RX
TAY ;SAVE IN Y REG
POP2 JSR DCR ;DECR RX
LDA (R0L,X) ;LOW ORDER BYTE
STA R0L ;TO R0
STY R0H
POP3 LDY $0 ;INDICATE R0 AS LAST RESULT REG
STY R14H
RTS
LDDAT JSR LDAT ;LOW ORDER BYTE TO R0, INCR RX
LDA (R0L,X) ;HIGH ORDER BYTE TO R0
STA R0H
JMP INR ;INCR RX
STDAT JSR STAT ;STORE INDIRECT LOW ORDER
LDA R0H ;BYTE AND INCR RX. THEN
STA (R0L,X) ;STORE HIGH ORDER BYTE.
JMP INR ;INCR RX AND RETURN
STPAT JSR DCR ;DECR RX
LDA R0L
STA (R0L,X) ;STORE R0 LOW BYTE @RX
JMP POP3 ;INDICATE R0 AS LAST RESULT REG
DCR LDA R0L,X
BNE DCR2 ;DECR RX
DEC R0H,X
DCR2 DEC R0L,X
RTS
SUB LDY $0 ;RESULT TO R0
CPR SEC ;NOTE Y REG = 13*2 FOR CPR
LDA R0L
SBC R0L,X
STA R0L,Y ;R0-RX TO RY
LDA R0H
SBC R0H,X
SUB2 STA R0H,Y
TYA ;LAST RESULT REG*2
ADC $0 ;CARRY TO LSB
STA R14H
RTS
ADD LDA R0L
ADC R0L,X
STA R0L ;R0+RX TO R0
LDA R0H
ADC R0H,X
LDY $0 ;R0 FOR RESULT
BEQ SUB2 ;FINISH ADD
BS LDA R15L ;NOTE X REG IS 12*2!
JSR STAT2 ;PUSH LOW PC BYTE VIA R12
LDA R15H
JSR STAT2 ;PUSH HIGH ORDER PC BYTE
BR CLC
BNC BCS BNC2 ;NO CARRY TEST
BR1 LDA (R15L),Y ;DISPLACEMENT BYTE
BPL BR2
DEY
BR2 ADC R15L ;ADD TO PC
STA R15L
TYA
ADC R15H
STA R15H
BNC2 RTS
BC BCS BR
RTS
BP ASL ;DOUBLE RESULT-REG INDEX
TAX ;TO X REG FOR INDEXING
LDA R0H,X ;TEST FOR PLUS
BPL BR1 ;BRANCH IF SO
RTS
BM ASL ;DOUBLE RESULT-REG INDEX
TAX
LDA R0H,X ;TEST FOR MINUS
BMI BR1
RTS
BZ ASL ;DOUBLE RESULT-REG INDEX
TAX
LDA R0L,X ;TEST FOR ZERO
ORA R0H,X ;(BOTH BYTES)
BEQ BR1 ;BRANCH IF SO
RTS
BNZ ASL ;DOUBLE RESULT-REG INDEX
TAX
LDA R0L,X ;TEST FOR NON-ZERO
ORA R0H,X ;(BOTH BYTES)
BNE BR1 ;BRANCH IF SO
RTS
BM1 ASL ;DOUBLE RESULT-REG INDEX
TAX
LDA R0L,X ;CHECK BOTH BYTES
AND R0H,X ;FOR $FF (MINUS 1)
EOR $FF
BEQ BR1 ;BRANCH IF SO
RTS
BNM1 ASL ;DOUBLE RESULT-REG INDEX
TAX
LDA R0L,X
AND R0H,X ;CHECK BOTH BYTES FOR NO $FF
EOR $FF
BNE BR1 ;BRANCH IF NOT MINUS 1
NUL RTS
RS LDX $18 ;12*2 FOR R12 AS STACK POINTER
JSR DCR ;DECR STACK POINTER
LDA (R0L,X) ;POP HIGH RETURN ADDRESS TO PC
STA R15H
JSR DCR ;SAME FOR LOW ORDER BYTE
LDA (R0L,X)
STA R15L
RTS
RTN JMP RTNZ
.org $f000
init:
lda #$00 ; init output ports of pia 2
sta mtalock ; reset multitasking lock
lda #$40 ; setup timer for free running
sta acr
lda #$c0 ; enable timer interrupts
sta ier
ldy #0
lda #0
stinit: sta $100,y ; reset stack to x'00'
iny
bne stinit
lda #$00 ; set actual task # to 0
sta mtatask
ldy #maxtask-1 ; get max. number of tasks
initloop:
lda mtasini,y ; get initial stackpointer value
sta mtastab,y ; and save value in page 0 table
tax ; move stack pointer value to reg x
lda #$b0 ; set initial flag register contents
sta $0104,x ; save flag register on stack
tya ; get actual task number
asl a ; multiply with 2
tax ; and move result to reg x
stx mtatemp ; save reg x
lda ent_tab,x ; get pcl-value
ldx mtastab,y ; get stack pointer value
sta $0105,x ; save pcl register on stack
ldx mtatemp ; get reg x
lda ent_tab+1,x ; get pch-value
ldx mtastab,y ; get stack pointer value
sta $0106,x ; save pch register on stack
dey
bpl initloop ; ==> loop for all tasks
ldx #$3f ; set stack for task 0
txs
lda #0 ; initial load timer
sta t1lsl
lda #40 ; about 1/100 sec timer value
sta t1csh
cli ; enable interrupts
jmp ent_task0 ; enter task 0
;*------------------------------------------------------------------*
;* table of task entry addresses *
;*------------------------------------------------------------------*
ent_tab:
.word ent_task0
.word ent_task1
.word ent_task2
.word ent_task3
;*------------------------------------------------------------------*
;* program call entry to interrupt service routine *
;*------------------------------------------------------------------*
mtaentry:
php ; save processor status on stack
; ; for interrupt simulation
pha ; save registers on current stack
txa
pha
tya
pha
tsx
inc $105,x ; add 1 to return address
bne mtaent01 ; because of jsr command
inc $106,x
mtaent01:
lda #$00 ; reset task lock
sta mtalock
jmp mtaswitch ; and process task switch
;*------------------------------------------------------------------*
;* interrupt service routine *
;*------------------------------------------------------------------*
irq:
pha ; save registers on current stack
txa
pha
tya
pha
lda t1csl ; enable interrupt
lda #$c0 ; reset flag
sta ifr
lda mtalock ; is task locked ?
beq mtaswitch ; ==> no, then process task change
inc mtalock ; indicate task switch requested
jmp irq_ret ; ==> and skip task change
mtaswitch: ; task switcher
ldy mtatask ; get actual task number
tsx ; get actual stack pointer
stx mtastab,y ; and save it in table
iny ; calculate next task number
cpy #maxtask ; valid task number ?
bcc mtanumok ; ==> yes
ldy #0 ; else start with task 0
mtanumok:
sty mtatask ; save new task number
ldx mtastab,y ; get new stack pointer
txs ; and load it in sp-register
irq_ret:
pla ; load registers from current stack
tay
pla
tax
pla
rti ; ==> go and process task
mtasini .byte $39,$79,$b9,$f9 ; initial stackpointer values
maxtask =$-mtasini
.org $fffa
nmivector .word init ; nmi vector
resvector .word init ; reset vector
irqvector .word irq ; irq vector
.end
Reference in New Issue Copy Permalink