; ; 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