ca65 V2.17 - Git 582aa41 Main file : monitor+applications.ca65 Current file: monitor+applications.ca65 000000r 1 ; 000000r 1 ; ACORN System 1 Monitor and Applications (Issue 2) 000000r 1 ; 000000r 1 ; This is the Acorn System 1 Monitor together with applications from the Acorn 000000r 1 ; System 1 User's and Teletext Board Technical Manuals and some other sources. 000000r 1 ; 000000r 1 ; (Chris Oddy December 2021) 000000r 1 ; 000000r 1 ; Assembled to load into a 4K EPROM. 000000r 1 ; 000000r 1 .setcpu "6502" 000000r 1 .listbytes unlimited 000000r 1 .org $F000 00F000 1 ; 00F000 1 ; Code and comments are taken from the manuals with some corrections. 00F000 1 ; 00F000 1 ; The Monitor program (512 bytes) starts at $FE00. 00F000 1 ; The Applications are at $F000 onwards as follows: 00F000 1 ; 00F000 1 ; Mathematical Applications 00F000 1 ; Square Root entry point for decimal: $F000, hexadecimal: $F003 00F000 1 ; Divider entry point for decimal: $F03F, hexadecimal: $F042 00F000 1 ; Single Byte Multiply entry point: $F085 00F000 1 ; Double Byte Multiply entry point: $F0AA 00F000 1 ; System Applications 00F000 1 ; Decimal to Hexadecimal entry point: $F0F2 00F000 1 ; Hexidecimal to Decimal entry point: $F132 00F000 1 ; Branch Offset Calculator entry point: $F16D 00F000 1 ; Relocator entry point: $F1D0 00F000 1 ; Tape Programs TEST entry point: $F1FE 00F000 1 ; RETAG entry point: $F206 00F000 1 ; Scroll entry point: $F23E 00F000 1 ; VDU entry point: $F24C 00F000 1 ; Acorn Keywrite entry point: $F336 00F000 1 ; Disassembler entry point: $F364 00F000 1 ; Minidisassembler entry point: $F3DA 00F000 1 ; Games 00F000 1 ; Nim entry point for Human Move: $F451 00F000 1 ; entry point for Computer Move: $F47C 00F000 1 ; Duck Shoot entry point: $F505 00F000 1 ; Bulls and Cows (Mastermind) entry point: $F611 (code starts at $F545) 00F000 1 ; Miscellanous 00F000 1 ; Counter Keyboard entry point: $F711 00F000 1 ; Keyboard Counter Subroutine entry point: $F754 00F000 1 ; Metronome entry point: $F76B 00F000 1 ; Eight Queens Problem entry point: $F79F 00F000 1 ; 'Acorn 1' entry point: $F7F2 00F000 1 ; 00F000 1 ; MONITOR Zero Page Registers 00F000 1 ; 00F000 1 MAP := $00 ; M Address 00F000 1 GAP := $02 ; GO Address 00F000 1 PAP := $04 ; Breakpoint Address 00F000 1 FAP := $06 ; Tape From Address 00F000 1 TAP := $08 ; Tape To Address 00F000 1 R0 := $0A ; Register 0, A after Breakpoint 00F000 1 R1 := $0B ; Register 1, X after Breakpoint 00F000 1 R2 := $0C ; Register 2, Y after Breakpoint 00F000 1 R3 := $0D ; Register 3, P after Breakpoint 00F000 1 KEY := $0D ; Last Pressed Key 00F000 1 REPEAT := $0E ; Single or Repeat Scan 00F000 1 EXEC := $0F ; Execution Status 00F000 1 D := $10 ; Display Address 00F000 1 R4 := $10 ; Register 4, PCH after Breakpoint 00F000 1 R5 := $11 ; Register 5, PCL after Breakpoint 00F000 1 R6 := $12 ; Register 6 00F000 1 R7 := $13 ; Register 7 00F000 1 P := $18 ; Breakpoint Storage 00F000 1 COL := $19 ; Key Column 00F000 1 TX := $1A ; Temporary X Storage 00F000 1 TY := $1A ; Temporary Y Storage 00F000 1 RECAL := $1B ; Breakpoint Correction 00F000 1 USERNMI := $001C ; NMI Routine Address 00F000 1 USERIRQ := $001E ; IRQ Routine Address 00F000 1 STACK := $0100 ; CPU stack 00F000 1 ; 00F000 1 ; Hardware Address's 00F000 1 ; 00F000 1 PIA := $0E20 ; A Programmable I/O 00F000 1 PIB := $0E21 ; B Programmable I/O 00F000 1 ADDR := $0E22 ; A Data direction register 00F000 1 BDDR := $0E23 ; B Data direction register 00F000 1 ; 00F000 1 ; *** HEXADECIMAL/DECIMAL SQUARE ROOT *** 00F000 1 ; 00F000 1 SQL := $20 00F000 1 SQH := $21 00F000 1 ROOT := $22 00F000 1 SUBL := $23 00F000 1 SUBH := $24 00F000 1 ; 00F000 1 F8 SQRDEC: sed ; entry point for decimal square root 00F001 1 F0 01 beq SQROOT ; always branch 00F003 1 D8 SQRHEX: cld ; entry point for hexadecimal square root 00F004 1 84 21 SQROOT: sty SQH ; clear square to prompt 00F006 1 84 20 sty SQL 00F008 1 A2 20 ldx #SQL 00F00A 1 20 88 FE jsr QDATFET ; fetch the number whose root is to be found 00F00D 1 84 24 sty SUBH ; clear high part of subtracting number 00F00F 1 84 22 sty ROOT ; clear root 00F011 1 C8 iny 00F012 1 84 23 sty SUBL ; subtract 001 at start 00F014 1 A4 20 ldy SQL ; use Y & X as double sized accumulator 00F016 1 A6 21 ldx SQH 00F018 1 38 NXTSUB: sec ; subtract SUB from X & Y 00F019 1 98 tya 00F01A 1 E5 23 sbc SUBL 00F01C 1 A8 tay 00F01D 1 8A txa 00F01E 1 E5 24 sbc SUBH 00F020 1 AA tax 00F021 1 90 14 bcc RESLT1 ; if negative then stop 00F023 1 A9 00 lda #$00 ; not finished yet, increment root 00F025 1 65 22 adc ROOT 00F027 1 85 22 sta ROOT 00F029 1 A5 23 lda SUBL ; increment SUB 00F02B 1 69 02 adc #$02 00F02D 1 85 23 sta SUBL 00F02F 1 A5 24 lda SUBH 00F031 1 69 00 adc #$00 00F033 1 85 24 sta SUBH 00F035 1 90 E1 bcc NXTSUB ; there can be no carry: branch always 00F037 1 A5 22 RESLT1: lda ROOT 00F039 1 20 60 FE jsr RDHEXTD ; display answer 00F03C 1 4C 04 FF jmp RESTART 00F03F 1 ; 00F03F 1 ; *** DIVIDER *** 00F03F 1 ; 00F03F 1 DIVIDR := $20 00F03F 1 DIVISR := $22 00F03F 1 RESULT := $24 00F03F 1 ; 00F03F 1 F8 DIVDEC: sed ; entry point for decimal divide 00F040 1 F0 01 beq DIVIDE ; always branch 00F042 1 D8 DIVHEX: cld ; entry point for hexadecimal divide 00F043 1 84 20 DIVIDE: sty DIVIDR ; clear dividend - prompt for number 00F045 1 84 21 sty DIVIDR+1 00F047 1 A9 11 lda #$11 ; prompt for second number 00F049 1 85 22 sta DIVISR 00F04B 1 A2 20 ldx #$20 00F04D 1 20 88 FE jsr QDATFET ; fetch dividend 00F050 1 A2 22 ldx #$22 00F052 1 20 88 FE jsr QDATFET ; fetch divisor 00F055 1 84 24 sty RESULT ; clear result 00F057 1 84 25 sty RESULT+1 00F059 1 A4 20 ldy DIVIDR ; use Y & X as double accumulator 00F05B 1 A6 21 ldx DIVIDR+1 00F05D 1 38 SUB: sec ; subtract the divisor 00F05E 1 98 tya 00F05F 1 E5 22 sbc DIVISR 00F061 1 A8 tay 00F062 1 8A txa 00F063 1 E9 00 sbc #$00 00F065 1 AA tax 00F066 1 90 10 bcc RESLT2 ; if negative then finished 00F068 1 84 23 sty DIVISR+1 ; else update the remainder 00F06A 1 A5 24 lda RESULT ; and add one to the result 00F06C 1 69 00 adc #$00 ; (carry was set on input) 00F06E 1 85 24 sta RESULT 00F070 1 A5 25 lda RESULT+1 00F072 1 69 00 adc #$00 00F074 1 85 25 sta RESULT+1 00F076 1 90 E5 bcc SUB ; no carry is possible (usually) 00F078 1 A2 24 RESLT2: ldx #$24 00F07A 1 20 64 FE jsr QHEXTD1 ; display result 00F07D 1 A5 23 lda DIVISR+1 00F07F 1 20 60 FE jsr RDHEXTD ; and remainder 00F082 1 4C 04 FF jmp RESTART 00F085 1 ; 00F085 1 ; *** SINGLE BYTE MULTIPLY *** 00F085 1 ; 00F085 1 D8 SMULT: cld 00F086 1 EA nop ; serves no purpose ? 00F087 1 84 20 sty $20 ; setup prompt for zero multiplier 00F089 1 A9 11 lda #$11 00F08B 1 85 21 sta $21 ; prompt for first - multiplicand 00F08D 1 A2 20 ldx #$20 00F08F 1 20 88 FE jsr QDATFET ; fetch the numbers 00F092 1 98 tya ; clears A 00F093 1 A0 08 ldy #$08 ; loop counter 00F095 1 66 20 LOOP1: ror $20 ; shift multiplier (and high byte of result) 00F097 1 90 03 bcc NADS ; no add if not bit 00F099 1 18 clc 00F09A 1 65 21 adc $21 ; add multiplicand into low byte of result 00F09C 1 6A NADS: ror A ; and shift low byte of result 00F09D 1 88 dey 00F09E 1 D0 F5 bne LOOP1 00F0A0 1 85 21 sta $21 ; put in low byte 00F0A2 1 66 20 ror $20 ; final justification shift 00F0A4 1 20 64 FE jsr QHEXTD1 ; display answer 00F0A7 1 4C 04 FF jmp RESTART 00F0AA 1 ; 00F0AA 1 ; *** DOUBLE BYTE MULTIPLY *** 00F0AA 1 ; 00F0AA 1 MPIER := $20 00F0AA 1 MPICAND := $22 00F0AA 1 ; 00F0AA 1 D8 DMULT: cld ; binary only 00F0AB 1 84 20 sty MPIER ; form prompt for the zero input 00F0AD 1 84 21 sty MPIER+1 00F0AF 1 A9 11 lda #$11 00F0B1 1 85 22 sta MPICAND ; form prompt for the first input 00F0B3 1 85 23 sta MPICAND+1 00F0B5 1 A2 20 ldx #$20 00F0B7 1 20 88 FE jsr QDATFET ; fetch zero input 00F0BA 1 A2 22 ldx #$22 00F0BC 1 20 88 FE jsr QDATFET 00F0BF 1 84 24 sty $24 ; clear working space 00F0C1 1 84 25 sty $25 00F0C3 1 A0 10 ldy #$10 ; loop count initialisation 00F0C5 1 66 23 LOOP2: ror MPICAND+1 ; two byte shift right 00F0C7 1 66 22 ror MPICAND 00F0C9 1 90 0D bcc NADD ; no add if the o/p bit isn't a one 00F0CB 1 18 clc 00F0CC 1 A5 20 lda MPIER ; two byte add 00F0CE 1 65 24 adc $24 00F0D0 1 85 24 sta $24 00F0D2 1 A5 21 lda MPIER+1 00F0D4 1 65 25 adc $25 00F0D6 1 85 25 sta $25 ; no carry out of the add 00F0D8 1 66 25 NADD: ror $25 ; shift again 00F0DA 1 66 24 ror $24 00F0DC 1 88 dey 00F0DD 1 D0 E6 bne LOOP2 ; go round loop 16 times 00F0DF 1 66 23 ror MPICAND+1 00F0E1 1 66 22 ror MPICAND 00F0E3 1 A0 06 ldy #$06 ; set up position 00F0E5 1 20 66 FE jsr QHEXTD2 ; X already pointing at correct locations 00F0E8 1 ; put 4 hex out 00F0E8 1 A0 02 ldy #$02 ; next position 00F0EA 1 A2 24 ldx #$24 ; set up X 00F0EC 1 20 66 FE jsr QHEXTD2 ; put next 4 out 00F0EF 1 4C 04 FF jmp RESTART ; display result 00F0F2 1 ; 00F0F2 1 ; *** DECIMAL TO HEXADECIMAL *** 00F0F2 1 ; 00F0F2 1 DECL := $20 00F0F2 1 DECH := $21 00F0F2 1 DECVH := $22 00F0F2 1 ; 00F0F2 1 98 DECHEX: tya ; clear A 00F0F3 1 85 20 sta DECL ; clear No 00F0F5 1 85 21 sta DECH 00F0F7 1 A2 20 ldx #DECL 00F0F9 1 85 22 AGAIN1: sta DECVH ; fetch the first digit 00F0FB 1 20 7A FE jsr HEXTD 00F0FE 1 20 0C FE jsr DISPLAY 00F101 1 90 F6 bcc AGAIN1 00F103 1 20 88 FE jsr QDATFET ; and then the last four digits 00F106 1 F8 sed ; decimal mode 00F107 1 84 10 sty D ; clear left display 00F109 1 A6 21 ldx DECH ; X & Y as double accumulator 00F10B 1 98 tya 00F10C 1 85 21 sta DECH 00F10E 1 A4 20 ldy DECL 00F110 1 85 20 sta DECL 00F112 1 38 NEXT1: sec ; do a decimal subtract, double byte 00F113 1 98 ALSO: tya 00F114 1 E9 01 sbc #$01 00F116 1 A8 tay 00F117 1 8A txa 00F118 1 E9 00 sbc #$00 00F11A 1 AA tax 00F11B 1 B0 04 bcs NODEC1 00F11D 1 C6 22 dec DECVH ; last of the decimal subtract, to do 5 digits 00F11F 1 30 09 bmi RESLT3 ; if minus then finished 00F121 1 E6 20 NODEC1: inc DECL ; double hex increment 00F123 1 D0 ED bne NEXT1 00F125 1 E6 21 inc DECH 00F127 1 38 sec ; create branch always, but don't bother to set the carry twice 00F128 1 B0 E9 bcs ALSO 00F12A 1 A2 20 RESLT3: ldx #$20 00F12C 1 20 64 FE jsr QHEXTD1 ; display result 00F12F 1 4C 04 FF jmp RESTART 00F132 1 00F132 1 ; 00F132 1 ; *** HEXADECIMAL TO DECIMAL *** 00F132 1 ; 00F132 1 HEXL := $20 00F132 1 HEXH := $21 00F132 1 DECOUT := $22 00F132 1 ; 00F132 1 84 20 HEXDEC: sty HEXL ; set up zero prompt 00F134 1 84 21 sty HEXH 00F136 1 A2 20 ldx #HEXL 00F138 1 20 88 FE jsr QDATFET ; and fetch the data 00F13B 1 F8 sed ; decimal mode 00F13C 1 A2 00 ldx #$00 ; set X & Y & DECOUT to zero 00F13E 1 86 22 stx DECOUT 00F140 1 A5 20 DECRHX: lda HEXL ; test for zero, then decrement 00F142 1 D0 06 bne NODEC2 00F144 1 A5 21 lda HEXH 00F146 1 F0 13 beq DEAD ; if hex No. zero, then finished 00F148 1 C6 21 dec HEXH 00F14A 1 C6 20 NODEC2: dec HEXL 00F14C 1 18 clc ; add 1 to decimal number, 00F14D 1 98 tya ; using X & Y as two byte accumulator 00F14E 1 69 01 adc #$01 00F150 1 A8 tay 00F151 1 8A txa 00F152 1 69 00 adc #$00 00F154 1 AA tax 00F155 1 90 E9 bcc DECRHX 00F157 1 E6 22 inc DECOUT 00F159 1 B0 E5 bcs DECRHX 00F15B 1 84 20 DEAD: sty HEXL ; finished, so store X & Y 00F15D 1 86 21 stx HEXH 00F15F 1 A2 20 ldx #HEXL 00F161 1 20 64 FE jsr QHEXTD1 ; display 4 digits 00F164 1 88 dey 00F165 1 A5 22 lda DECOUT 00F167 1 20 7A FE jsr HEXTD ; display 5th digit 00F16A 1 4C 04 FF jmp RESTART 00F16D 1 ; 00F16D 1 ; *** BRANCH OFFSET CALCULATOR *** 00F16D 1 ; 00F16D 1 MESSL := $20 00F16D 1 MESSH := $21 00F16D 1 FROMH := $22 00F16D 1 FROML := $23 00F16D 1 TOL := $24 00F16D 1 TOH := $25 00F16D 1 ; 00F16D 1 D8 OFFSET: cld 00F16E 1 A9 02 AGAIN2: lda #$02 00F170 1 85 21 sta MESSH ; initialise message pointer 00F172 1 84 22 sty FROMH ; setup prompt 00F174 1 84 23 sty FROML 00F176 1 A2 22 ldx #FROMH 00F178 1 20 88 FE jsr QDATFET ; fetch first address 00F17B 1 A9 11 lda #$11 ; set up 2nd prompt 00F17D 1 85 24 sta TOL 00F17F 1 85 25 sta TOH 00F181 1 A2 24 ldx #TOL 00F183 1 20 88 FE jsr QDATFET ; fetch second adress 00F186 1 A5 22 lda FROMH ; offset to make overlength easy 00F188 1 E9 7E sbc #$7E ; carry known set by QDATFET 00F18A 1 85 22 sta FROMH 00F18C 1 B0 03 bcs HSUB ; don't set the carry again 00F18E 1 C6 23 dec FROML 00F190 1 38 sec 00F191 1 A5 24 HSUB: lda TOL ; calculate the length 00F193 1 E5 22 sbc FROMH 00F195 1 AA tax 00F196 1 A5 25 lda TOH 00F198 1 E5 23 sbc FROML 00F19A 1 D0 0E bne TOOFAR 00F19C 1 A9 55 lda #$55 00F19E 1 20 B5 F1 jsr MESSAGE ; print out 00F1A1 1 8A txa 00F1A2 1 49 80 eor #$80 ; complement top bit because of the offset applied 00F1A4 1 20 60 FE jsr RDHEXTD ; print out answer, over writing the 00F1A7 1 4C 04 FF jmp RESTART ; finished 00F1AA 1 A9 5B TOOFAR: lda #$5B ; whoops 00F1AC 1 20 B5 F1 jsr MESSAGE ; tell the programmer that its wrong 00F1AF 1 20 0C FE jsr DISPLAY 00F1B2 1 4C 6E F1 jmp AGAIN2 00F1B5 1 85 20 MESSAGE:sta MESSL ; message described by A 00F1B7 1 A0 07 ldy #$07 ; eight bytes of data to display 00F1B9 1 B1 20 LOOP3: lda (MESSL),y ; fetch them 00F1BB 1 99 10 00 sta D,y 00F1BE 1 88 dey 00F1BF 1 10 F8 bpl LOOP3 00F1C1 1 60 rts 00F1C2 1 53 71 71 6D .byte $53,$71,$71,$6D,$79,$F8,$78,$5C 00F1C6 1 79 F8 78 5C 00F1CA 1 5C 00 71 5C .byte $5C,$00,$71,$5C,$50,$00 00F1CE 1 50 00 00F1D0 1 ; 00F1D0 1 ; *** RELOCATOR *** 00F1D0 1 ; 00F1D0 1 A2 F1 RELOC: ldx #$F1 00F1D2 1 86 10 stx D ; setup from prompt F. 00F1D4 1 A2 20 ldx #$20 00F1D6 1 20 88 FE jsr QDATFET ; and get address 00F1D9 1 A2 46 ldx #$46 00F1DB 1 86 10 stx D ; setup end prompt 00F1DD 1 A2 22 ldx #$22 00F1DF 1 20 88 FE jsr QDATFET ; and get second address 00F1E2 1 A2 78 ldx #$78 ; move the data between these addresses 00F1E4 1 86 10 stx D ; setup prompt 00F1E6 1 A2 24 ldx #$24 00F1E8 1 20 88 FE jsr QDATFET ; and get base address 00F1EB 1 A2 1A ldx #$1A ; move to here & successive locations 00F1ED 1 A1 06 MOVE: lda ($06,x) ; do the move 00F1EF 1 91 24 sta ($24),y 00F1F1 1 C8 iny 00F1F2 1 D0 02 bne NOINC2 00F1F4 1 E6 25 inc $25 00F1F6 1 20 A0 FE NOINC2: jsr COM16 ; use COM16 to do the limit test 00F1F9 1 D0 F2 bne MOVE 00F1FB 1 4C 04 FF jmp RESTART 00F1FE 1 ; 00F1FE 1 ; *** TAPE USE PROGRAMS *** 00F1FE 1 ; 00F1FE 1 A9 55 TEST: lda #$55 ; the test byte 00F200 1 20 B1 FE jsr PUTBYTE ; send it 00F203 1 4C FE F1 jmp TEST ; keep sending it 00F206 1 ; 00F206 1 A9 F1 RETAG: lda #$F1 ; F. prompt 00F208 1 85 10 sta D 00F20A 1 A2 06 ldx #$06 00F20C 1 20 88 FE jsr QDATFET ; first address 00F20F 1 A2 08 ldx #$08 00F211 1 86 10 stx D ; prompt 00F213 1 20 88 FE jsr QDATFET ; second address 00F216 1 A9 46 lda #$46 ; prompt 00F218 1 85 10 sta D 00F21A 1 A2 20 ldx #$20 00F21C 1 20 88 FE jsr QDATFET ; last address: actual data start 00F21F 1 A2 04 ldx #$04 00F221 1 B5 05 ADRSS: lda $05,x ; send fake address 00F223 1 20 B1 FE jsr PUTBYTE 00F226 1 CA dex 00F227 1 D0 F8 bne ADRSS 00F229 1 A0 00 DATAS1: ldy #$00 00F22B 1 B1 20 lda ($20),y ; proper data 00F22D 1 E6 20 inc $20 ; increment proper data counter 00F22F 1 D0 02 bne NOINC3 00F231 1 E6 21 inc $21 00F233 1 20 B1 FE NOINC3: jsr PUTBYTE ; send data 00F236 1 20 A0 FE jsr COM16 ; check fake addresses for end 00F239 1 D0 EE bne DATAS1 00F23B 1 4C 04 FF jmp RESTART 00F23E 1 ; 00F23E 1 ; *** SCROLL *** 00F23E 1 ; 00F23E 1 A2 00 SCROLL: ldx #$00 ; must go forwards 00F240 1 B4 11 LOOP4: ldy D+1,x ; pick-up data on right 00F242 1 94 10 sty D,x ; & move it one left 00F244 1 E8 inx 00F245 1 E0 07 cpx #$07 00F247 1 D0 F7 bne LOOP4 ; keep going 00F249 1 85 11 sta D+1 ; new data 00F24B 1 60 rts 00F24C 1 ; 00F24C 1 ; *** VDU *** (from Teletext Board Technical Manual) 00F24C 1 ; 00F24C 1 LF := $0A ; LineFeed 00F24C 1 FF := $0C ; FormFeed 00F24C 1 CR := $0D ; Carriage Return 00F24C 1 DEL := $7F ; DELete 00F24C 1 SCAP := $20 00F24C 1 LINE := $21 00F24C 1 WORK := $23 00F24C 1 SCRA := $0400 ; memory addresses for the screen 00F24C 1 SCRB := $0500 00F24C 1 SCRC := $0600 00F24C 1 SCRD := $0700 00F24C 1 CRTA := $0800 ; 6845 crt controller 00F24C 1 CRTB := $0801 00F24C 1 ; 00F24C 1 VDU: 00F24C 1 A4 20 CHATS: ldy SCAP ; CHAracter To Screen 00F24E 1 C9 20 cmp #$20 00F250 1 90 37 bcc CTL ; all control characters 00F252 1 C9 7F cmp #DEL 00F254 1 F0 27 beq DELETE 00F256 1 20 19 F3 TOSCRN: jsr WRCH 00F259 1 C8 iny 00F25A 1 C0 28 cpy #$28 00F25C 1 90 05 bcc VDUB ; automatic scroll when line filled 00F25E 1 20 3E F2 FILLED: jsr SCROLL 00F261 1 A0 00 VDUA: ldy #$00 00F263 1 20 01 F3 VDUB: jsr CALCN 00F266 1 84 20 sty SCAP 00F268 1 A0 0F ldy #$0F ; rewrite cursor position 00F26A 1 8C 00 08 sty CRTA 00F26D 1 A4 23 ldy WORK 00F26F 1 8C 01 08 sty CRTB 00F272 1 A0 0E ldy #$0E 00F274 1 8C 00 08 sty CRTA 00F277 1 A4 25 ldy WORK+2 00F279 1 8C 01 08 sty CRTB 00F27C 1 60 VDUC: rts 00F27D 1 00F27D 1 88 DELETE: dey 00F27E 1 30 FC bmi VDUC ; refuse to delete before line start 00F280 1 A9 20 lda #$20 ; write in a blank 00F282 1 20 19 F3 jsr WRCH 00F285 1 A9 7F lda #$7F 00F287 1 D0 DA bne VDUB 00F289 1 C9 0D CTL: cmp #CR ; carriage return ? 00F28B 1 F0 D4 beq VDUA 00F28D 1 C9 0A cmp #LF ; linefeed ? 00F28F 1 F0 06 beq SCR 00F291 1 C9 0C cmp #FF ; formfeed ? 00F293 1 F0 09 beq CLEARS 00F295 1 D0 BF bne TOSCRN 00F297 1 20 CC F2 SCR: jsr SCROL ; scroll screen and rewrite cursor 00F29A 1 A4 20 ldy SCAP 00F29C 1 B0 C5 bcs VDUB 00F29E 1 48 CLEARS: pha ; clear entire buffer 00F29F 1 A0 00 ldy #$00 00F2A1 1 A9 20 lda #$20 00F2A3 1 99 00 04 CLR: sta SCRA,y 00F2A6 1 99 00 05 sta SCRB,y 00F2A9 1 99 00 06 sta SCRC,y 00F2AC 1 99 00 07 sta SCRD,y 00F2AF 1 C8 iny 00F2B0 1 D0 F1 bne CLR 00F2B2 1 84 20 sty SCAP 00F2B4 1 A0 0F ldy #$0F 00F2B6 1 8C 00 08 SETCRT: sty CRTA ; set up all the crt parameters 00F2B9 1 B9 26 F3 lda CRTTAB,y 00F2BC 1 8D 01 08 sta CRTB 00F2BF 1 88 dey 00F2C0 1 10 F4 bpl SETCRT 00F2C2 1 A9 C0 lda #$C0 00F2C4 1 85 21 sta LINE 00F2C6 1 A9 07 lda #$07 00F2C8 1 85 22 sta LINE+1 00F2CA 1 68 pla 00F2CB 1 60 rts 00F2CC 1 ; 00F2CC 1 08 SCROL: php ; scroll subroutine 00F2CD 1 48 pha 00F2CE 1 D8 cld 00F2CF 1 A0 28 ldy #$28 00F2D1 1 20 01 F3 jsr CALCN 00F2D4 1 A5 23 lda WORK 00F2D6 1 85 21 sta LINE 00F2D8 1 A5 25 lda WORK+2 00F2DA 1 85 22 sta LINE+1 00F2DC 1 A0 0D ldy #$0D 00F2DE 1 8C 00 08 sty CRTA 00F2E1 1 A5 21 lda LINE 00F2E3 1 38 SEC 00F2E4 1 E9 C0 SBC #$C0 00F2E6 1 8D 01 08 sta CRTB 00F2E9 1 88 dey 00F2EA 1 8C 00 08 sty CRTA 00F2ED 1 A5 25 lda WORK+2 00F2EF 1 E9 03 SBC #$03 00F2F1 1 8D 01 08 sta CRTB 00F2F4 1 A0 27 ldy #$27 00F2F6 1 A9 20 lda #$20 00F2F8 1 20 19 F3 CLEARL: jsr WRCH 00F2FB 1 88 dey 00F2FC 1 10 FA bpl CLEARL 00F2FE 1 68 pla 00F2FF 1 28 plp 00F300 1 60 rts 00F301 1 00F301 1 08 CALCN: php ; do calculation to make sure that the 00F302 1 48 pha ; processor and crt controlier agree on 00F303 1 D8 cld ; position of screen 00F304 1 18 clc 00F305 1 98 tya 00F306 1 65 21 adc LINE 00F308 1 85 23 sta WORK 00F30A 1 A5 22 lda LINE+1 00F30C 1 69 00 adc #$00 00F30E 1 85 25 sta WORK+2 00F310 1 29 07 and #$07 00F312 1 09 04 ora #$04 00F314 1 85 24 sta WORK+1 00F316 1 68 pla 00F317 1 28 plp 00F318 1 60 rts 00F319 1 00F319 1 20 01 F3 WRCH: jsr CALCN 00F31C 1 84 25 sty WORK+2 00F31E 1 A0 00 ldy #$00 00F320 1 99 23 00 sta WORK,y 00F323 1 A4 25 ldy WORK+2 00F325 1 60 rts 00F326 1 ; 00F326 1 3F CRTTAB: .byte $3F ; total number of characters per line 00F327 1 28 .byte $28 ; 40 characters displayed 00F328 1 33 .byte $33 ; position of horizontal sync 00F329 1 05 .byte $05 ; width in uS of horizontal sync pulse 00F32A 1 1E .byte $1E ; total number of character rows 00F32B 1 02 .byte $02 ; additional no. of lines for 312 total 00F32C 1 19 .byte $19 ; 25 displayed character rows 00F32D 1 18 .byte $18 ; position of vertical sync pulse 00F32E 1 00 .byte $00 ; set non-interlace mode 00F32F 1 09 .byte $09 ; set 10 lines per character row 00F330 1 68 .byte $68 ; slow blink cursor from line 9 00F331 1 09 .byte $09 ; to line 10 00F332 1 04 .byte $04 ; high address of VDU ram 00F333 1 00 .byte $00 ; low address of VDU ram 00F334 1 07 .byte $07 ; high address of initial cursor position 00F335 1 C0 .byte $C0 ; low address of intial cursor position 00F336 1 ; 00F336 1 ; *** Acorn Keywrite *** (from Teletext Board Technical Manual) 00F336 1 ; 00F336 1 TEMP := $26 00F336 1 ; 00F336 1 20 0C FE KEYWRT: jsr DISPLAY 00F339 1 90 0E bcc SEND ; hex key ? 00F33B 1 29 07 CONTRL: and #$07 00F33D 1 F0 1B beq RET 00F33F 1 A8 tay ; look up control keys in table 00F340 1 B9 5C F3 lda TABLE-1,y 00F343 1 20 4C F2 SENDER: jsr CHATS 00F346 1 4C 36 F3 jmp KEYWRT 00F349 1 0A SEND: asl A 00F34A 1 0A asl A 00F34B 1 0A asl A 00F34C 1 0A asl A 00F34D 1 85 26 sta TEMP 00F34F 1 20 0C FE jsr DISPLAY 00F352 1 B0 E7 bcs CONTRL 00F354 1 05 26 ora TEMP ; mix in low digit 00F356 1 09 80 ora #$80 ; fool control character check 00F358 1 30 E9 bmi SENDER ; forced branch to SENDER 00F35A 1 4C 04 FF RET: jmp RESTART ; M key returns to MONITOR 00F35D 1 20 TABLE: .byte $20 ; G key gives space bar 00F35E 1 20 .byte $20 ; P key gives space bar 00F35F 1 20 .byte $20 ; S key gives space bar 00F360 1 0A .byte $0A ; L key gives linefeed 00F361 1 0C .byte $0C ; R key gives formfeed 00F362 1 7F .byte $7F ; key gives delete 00F363 1 0D .byte $0D ; key gives carriage return 00F364 1 ; 00F364 1 ; *** Disassembler *** (Computing Today April 1980) 00F364 1 ; 00F364 1 DOT := $80 00F364 1 UPKEY := $16 00F364 1 ; 00F364 1 A2 07 DISASS: ldx #$07 ; first clear the display 00F366 1 94 10 clear: sty $10,x 00F368 1 CA dex 00F369 1 D0 FB bne clear 00F36B 1 A5 00 lda MAP ; get opcode address 00F36D 1 20 6F FE jsr DHEXTD ; display least significant byte on left 00F370 1 A1 00 lda (MAP,x) ; get the opcode 00F372 1 A0 02 ldy #$02 00F374 1 20 6F FE jsr DHEXTD ; display this on next pair of digits 00F377 1 A1 00 lda (MAP,x) ; get it back and carry out disassembly 00F379 1 29 0F and #$0F ; remove first digit 00F37B 1 F0 2C beq check ; if second digit=0 check for 3-byters 00F37D 1 C9 08 cmp #$08 00F37F 1 90 0E bcc B2 ; if second digit<8 we have a 2-byter 00F381 1 F0 36 beq B1 ; if second digit=8 we have a 1-byter 00F383 1 C9 0A cmp #$0A 00F385 1 F0 32 beq B1 ; if second digit=A we have a 1-byter 00F387 1 B0 08 bcs B3 ; if second digit>A we have a 1-byter 00F389 1 A1 00 lda (MAP,x) ; get it back again 00F38B 1 29 10 and #$10 ; we are left with 9's 00F38D 1 D0 02 bne B3 ; if first digit odd we have a 3-byter 00F38F 1 A2 02 B2: ldx #$02 ; 2-Byte Opcode (remember in X) 00F391 1 88 B3: dey ; 3-Byte Opcode 00F392 1 B1 00 lda (MAP),y ; get second byte 00F394 1 A0 04 ldy #$04 00F396 1 20 6F FE jsr DHEXTD ; display it 00F399 1 8A txa ; if x=0 we have a 3-byter 00F39A 1 D0 1F bne finish ; otherwise we have a 2-byter 00F39C 1 A0 02 ldy #$02 00F39E 1 B1 00 lda (MAP),y ; get third byte 00F3A0 1 A0 06 ldy #$06 00F3A2 1 20 6F FE jsr DHEXTD ; display it 00F3A5 1 A2 03 ldx #$03 00F3A7 1 D0 12 bne finish ; 3-byte opcode finished 00F3A9 1 A1 00 check: lda (MAP,x) ; check for complicating opcodes - get opcode again 00F3AB 1 C9 20 cmp #$20 ; jsr ? 00F3AD 1 F0 E2 beq B3 00F3AF 1 29 F0 and #$F0 ; remove second digit leaving first 00F3B1 1 C9 80 cmp #$80 ; greater than 8 ? 00F3B3 1 B0 DA bcs B2 ; - 2-byter 00F3B5 1 29 10 and #$10 ; check if odd or even 00F3B7 1 D0 D6 bne B2 ; odd - 2-byter, otherwise 00F3B9 1 A2 01 B1: ldx #$01 ; 1-Byte Opcode - already finished 00F3BB 1 E6 00 finish: inc MAP ; increment MAP x times 00F3BD 1 D0 02 bne noinc ; to move to next opcode 00F3BF 1 E6 01 inc MAP+1 00F3C1 1 CA noinc: dex 00F3C2 1 D0 F7 bne finish ; increment again 00F3C4 1 A2 05 ldx #$05 ; now put dots on every 00F3C6 1 A9 80 dot: lda #DOT ; other digit to make it 00F3C8 1 15 10 ora $10,x ; more readable 00F3CA 1 95 10 sta $10,x 00F3CC 1 CA dex 00F3CD 1 CA dex 00F3CE 1 10 F6 bpl dot 00F3D0 1 20 0C FE jsr DISPLAY ; display disassembled opcode 00F3D3 1 C9 16 cmp #UPKEY ; was UP key pressed ? 00F3D5 1 F0 8D beq DISASS ; yes - carry on 00F3D7 1 4C 09 FF jmp SEARCH ; no - jump back to Monitor 00F3DA 1 ; 00F3DA 1 ; *** Minidisassembler *** (from Teletext Board Technical Manual) 00F3DA 1 ; 00F3DA 1 MOD := $00 00F3DA 1 COUNT1 := $0E 00F3DA 1 ; 00F3DA 1 A9 18 MINDIS: lda #$18 ; disassemble 25 lines 00F3DC 1 85 0E sta COUNT1 00F3DE 1 D8 cld 00F3DF 1 A9 0C lda #$0C ; start with a formfeed 00F3E1 1 20 4C F2 jsr CHATS 00F3E4 1 A9 0D MAIN1: lda #$0D ; carriage return/linefeed for each line 00F3E6 1 20 4C F2 jsr CHATS 00F3E9 1 A9 0A lda #$0A 00F3EB 1 20 4C F2 jsr CHATS 00F3EE 1 A5 01 lda MOD+1 ; display current address 00F3F0 1 20 34 F4 jsr SPBYTE 00F3F3 1 A5 00 lda MOD 00F3F5 1 20 3B F4 jsr BYTOUT 00F3F8 1 A0 00 ldy #$00 00F3FA 1 A2 01 ldx #$01 ; X will be the byte count of the opcode 00F3FC 1 B9 00 00 lda MOD,y ; fetch opcode, find it’s no. of bytes 00F3FF 1 C9 20 cmp #$20 ; ‘jsr' is an anomaly and is done first 00F401 1 F0 17 beq CBYTE 00F403 1 29 9F and #$9F 00F405 1 F0 15 beq ABYTE ; binary 0XX00000 is 1 byte 00F407 1 29 1D and #$1D 00F409 1 C9 19 cmp #$19 00F40B 1 F0 0D beq CBYTE ; binary XXX110X1 is 3 bytes 00F40D 1 29 0D and #$0D 00F40F 1 C9 08 cmp #$08 00F411 1 F0 09 beq ABYTE ; binary XXXXX0X0 (now) is 1 byte 00F413 1 29 0C and #$0C 00F415 1 C9 0C cmp #$0C 00F417 1 F0 01 beq CBYTE ; binary XXXX11XX is 3 bytes 00F419 1 CA dex ; all others are 2 bytes 00F41A 1 E8 CBYTE: inx 00F41B 1 E8 inx 00F41C 1 A0 00 ABYTE: ldy #$00 00F41E 1 B9 00 00 lda MOD,y 00F421 1 20 34 F4 jsr SPBYTE 00F424 1 E6 00 inc MOD ; increment the byte pointer 00F426 1 D0 02 bne NOINC4 00F428 1 E6 01 inc MOD+1 00F42A 1 CA NOINC4: dex ; print all bytes required 00F42B 1 D0 EF bne ABYTE 00F42D 1 C6 0E dec COUNT1 00F42F 1 10 B3 bpl MAIN1 ; finished the 25 lines ? 00F431 1 4C 04 FF GETOUT: jmp RESTART 00F434 1 48 SPBYTE: pha ; print a space and then the byte 00F435 1 A9 20 lda #$20 00F437 1 20 4C F2 jsr CHATS 00F43A 1 68 pla 00F43B 1 48 BYTOUT: pha ; print a byte 00F43C 1 4A lsr A 00F43D 1 4A lsr A 00F43E 1 4A lsr A 00F43F 1 4A lsr A 00F440 1 20 44 F4 jsr DIGOUT 00F443 1 68 pla 00F444 1 29 0F DIGOUT: and #$0F ; print the bottom hex digit in A 00F446 1 09 30 ora #$30 00F448 1 C9 3A cmp #$3A 00F44A 1 90 02 bcc PUT 00F44C 1 69 06 adc #$06 00F44E 1 4C 4C F2 PUT: jmp CHATS 00F451 1 ; 00F451 1 ; *** NIM *** 00F451 1 ; 00F451 1 COUNT2 := $1F 00F451 1 NSTACK := $20 00F451 1 POSS := $24 00F451 1 ANAL := $28 00F451 1 ; 00F451 1 20 EA F4 HUMMOV: jsr DSPGAP ; display stacks 00F454 1 B5 10 SHFTPT: lda D,x ; set decimal point on 00F456 1 09 80 ora #$80 00F458 1 95 11 sta D+1,x 00F45A 1 20 0C FE CHEAT: jsr DISPLAY ; wait for input 00F45D 1 90 10 bcc MINUS 00F45F 1 B5 11 lda D+1,x ; remove current decimal point 00F461 1 29 7F and #$7F 00F463 1 95 11 sta D+1,x 00F465 1 E8 inx ; move forward 00F466 1 E8 inx 00F467 1 E0 07 cpx #$07 ; end of stacks ? 00F469 1 90 E9 bcc SHFTPT 00F46B 1 A2 00 ldx #$00 00F46D 1 F0 E5 beq SHFTPT 00F46F 1 A8 MINUS: tay 00F470 1 F0 E8 beq CHEAT ; prevent zero from being used 00F472 1 8A txa 00F473 1 4A lsr A ; address of required stack 00F474 1 AA tax 00F475 1 38 sec 00F476 1 B5 20 lda NSTACK,x ; do the players move 00F478 1 E5 0D sbc KEY 00F47A 1 95 20 sta NSTACK,x 00F47C 1 20 EA F4 COMMOV: jsr DSPGAP ; show stacks 00F47F 1 84 0E sty REPEAT 00F481 1 A2 00 ldx #$00 00F483 1 20 0C FE WAIT1: jsr DISPLAY ; thinking time 00F486 1 CA dex 00F487 1 D0 FA bne WAIT1 00F489 1 CA dex 00F48A 1 86 0E stx REPEAT ; clear repeat status 00F48C 1 A0 03 ldy #$03 00F48E 1 A2 03 NEXT2: ldx #$03 ; transfer STACK to POSS 00F490 1 B5 20 BLOCK: lda NSTACK,x ; POSS repreensts the possible computer 00F492 1 95 24 sta POSS,x ; moves 00F494 1 CA dex 00F495 1 10 F9 bpl BLOCK 00F497 1 A2 03 ONEOFF: ldx #$03 ; transfer POSS to ANAL 00F499 1 B5 24 BRICK: lda POSS,x ; ANAL represents the move being 00F49B 1 95 28 sta ANAL,x ; analysed 00F49D 1 CA dex 00F49E 1 10 F9 bpl BRICK 00F4A0 1 A2 03 ldx #$03 00F4A2 1 B9 24 00 lda POSS,y 00F4A5 1 38 sec 00F4A6 1 E9 01 sbc #$01 00F4A8 1 99 24 00 sta POSS,y ; POSS contains possible move 00F4AB 1 99 28 00 sta ANAL,y ; ANAL contains possible move 00F4AE 1 B0 12 bcs CHECK 00F4B0 1 88 dey 00F4B1 1 10 DB bpl NEXT2 ; try all stacks 00F4B3 1 B5 20 TRY1: lda NSTACK,x ; check if stack is empty 00F4B5 1 F0 05 beq EMPTY 00F4B7 1 D6 20 dec NSTACK,x ; make desperate move 00F4B9 1 4C 51 F4 jmp HUMMOV 00F4BC 1 CA EMPTY: dex 00F4BD 1 10 F4 bpl TRY1 00F4BF 1 4C 04 FF jmp RESTART ; lost 00F4C2 1 A9 04 CHECK: lda #$04 00F4C4 1 85 1F sta COUNT2 00F4C6 1 A9 00 CONT: lda #$00 ; evaluate move 00F4C8 1 46 28 lsr ANAL 00F4CA 1 2A rol A 00F4CB 1 46 29 lsr ANAL+1 00F4CD 1 69 00 adc #$00 00F4CF 1 46 2A lsr ANAL+2 00F4D1 1 69 00 adc #$00 00F4D3 1 46 2B lsr ANAL+3 00F4D5 1 69 00 adc #$00 00F4D7 1 4A lsr A 00F4D8 1 B0 BD bcs ONEOFF ; not a good move 00F4DA 1 C6 1F dec COUNT2 00F4DC 1 D0 E8 bne CONT ; keep checking the move 00F4DE 1 A2 03 ldx #$03 ; good move, transfer to actual stacks 00F4E0 1 B5 24 BAT: lda POSS,x 00F4E2 1 95 20 sta NSTACK,x 00F4E4 1 CA dex 00F4E5 1 10 F9 bpl BAT 00F4E7 1 4C 51 F4 jmp HUMMOV ; opponent 00F4EA 1 A9 00 DSPGAP: lda #$00 00F4EC 1 A2 07 ldx #$07 00F4EE 1 95 10 CLEAR1: sta D,x ; clear the display first 00F4F0 1 CA dex 00F4F1 1 10 FB bpl CLEAR1 00F4F3 1 D8 cld ; clear decimal mode 00F4F4 1 A2 04 ldx #$04 00F4F6 1 A0 07 ldy #$07 00F4F8 1 B5 1F AROUND: lda NSTACK-1,x 00F4FA 1 20 7A FE jsr HEXTD 00F4FD 1 88 dey 00F4FE 1 88 dey 00F4FF 1 CA dex 00F500 1 D0 F6 bne AROUND 00F502 1 A0 1F ldy #$1F 00F504 1 60 rts 00F505 1 ; 00F505 1 ; *** DUCK SHOOT *** 00F505 1 ; 00F505 1 TIME := $0E 00F505 1 DEDDCK := $1C 00F505 1 DUCK := $61 00F505 1 ; 00F505 1 A9 1F BEGIN: lda #$1F ; single scan display routine 00F507 1 85 0E sta TIME 00F509 1 A9 00 lda #$00 ; clear the display 00F50B 1 A2 07 ldx #$07 00F50D 1 86 20 stx $20 00F50F 1 95 10 CLEAR2: sta $10,x 00F511 1 CA dex 00F512 1 10 FB bpl CLEAR2 00F514 1 A9 00 REMOVE: lda #$00 ; take the old duck off 00F516 1 A6 20 ldx $20 00F518 1 95 10 sta $10,x 00F51A 1 A9 61 INSERT: lda #DUCK ; put new duck on 00F51C 1 CA dex ; in new position 00F51D 1 10 02 bpl OLDX ; but not over the end of the display 00F51F 1 A2 07 ldx #$07 00F521 1 95 10 OLDX: sta $10,X 00F523 1 86 20 stx $20 00F525 1 A2 0E ldx #TIME ; display interval is set by the byte loaded into X 00F527 1 20 0C FE WAIT2: jsr DISPLAY 00F52A 1 C5 20 cmp $20 ; hit ? 00F52C 1 F0 05 beq HIT 00F52E 1 CA dex 00F52F 1 D0 F6 bne WAIT2 00F531 1 F0 E1 beq REMOVE ; finished wait time 00F533 1 A9 1C HIT: lda #DEDDCK ; put in a dead duck 00F535 1 A6 20 ldx $20 00F537 1 95 10 sta $10,x 00F539 1 A9 FF lda #$FF 00F53B 1 85 0E sta TIME 00F53D 1 20 0C FE jsr DISPLAY ; test for continuation 00F540 1 90 C3 bcc BEGIN 00F542 1 4C 04 FF jmp RESTART ; or back to the Monitor 00F545 1 ; 00F545 1 ; *** BULLS and COWS (MASTERMIND) *** (from the Liverpool Software Gazette) 00F545 1 ; 00F545 1 MESSPO := $0020 ; pointer to messages 00F545 1 RAN := $0022 ; random numbers here 00F545 1 MYNO := $0025 ; hidden Acorn's number 00F545 1 YGU := $0027 ; humans guess 00F545 1 NUMA := $0029 ; number to be matched 00F545 1 NUMB := $002D ; number to be matched with 00F545 1 BULLS := $0031 00F545 1 COWS := $0032 00F545 1 LIST := $0033 ; used to calculate cows 00F545 1 MYGU := $003B ; my new guess 00F545 1 STRT := $003D ; start of guesses 00F545 1 ANSWER := $003F ; answer from piran 00F545 1 GSEND := $0040 ; end of guess stack 00F545 1 GUNO := $0041 ; present guess on stack 00F545 1 TEMPA := $0042 ; two temporary locatiosn for ROR 00F545 1 TEMPB := $0043 00F545 1 ; 00F545 1 A9 00 MATCH: lda #$00 00F547 1 A2 09 ldx #$09 ; clear bulls, cows 00F549 1 95 31 CLEAR: sta BULLS,X ; and list 00F54B 1 CA dex 00F54C 1 10 FB bpl CLEAR 00F54E 1 A0 03 ldy #$03 00F550 1 B9 29 00 CMPARE: lda NUMA,Y ; digit from NUMA 00F553 1 D9 2D 00 cmp NUMB,Y ; is it a bull ? 00F556 1 D0 04 bne NOBULL ; no 00F558 1 E6 31 inc BULLS ; count a bull 00F55A 1 10 11 bpl NOCOWS ; it can't be a cow 00F55C 1 AA NOBULL: tax ; is it a cow then ? 00F55D 1 F6 33 inc LIST,X ; increment via digit 00F55F 1 F0 02 beq COWCNT ; it is a cow 00F561 1 10 02 bpl NOCOW ; it is not a cow 00F563 1 E6 32 COWCNT: inc COWS ; count a cow 00F565 1 B6 2D NOCOW: ldx NUMB,Y ; try other way 00F567 1 D6 33 dec LIST,X ; decrement via digit 00F569 1 30 02 bmi NOCOWS ; it is not a cow 00F56B 1 E6 32 inc COWS ; count a cow 00F56D 1 88 NOCOWS: dey ; next digit 00F56E 1 10 E0 bpl CMPARE ; round again 00F570 1 A5 31 lda BULLS ; now assemble answer 00F572 1 0A asl A 00F573 1 0A asl A 00F574 1 0A asl A 00F575 1 0A asl A 00F576 1 05 32 ora COWS 00F578 1 60 rts ; and return 00F579 1 B9 00 00 UNPACK: lda $0000,Y ; put number 00F57C 1 85 42 sta TEMPA ; to be unpacked 00F57E 1 B9 01 00 lda $0001,Y ; in TEMPA 00F581 1 A0 04 ldy #$04 ; (4 digits to unpack) 00F583 1 85 43 UNLOOP: sta TEMPB ; and TEMPB 00F585 1 29 07 and #$07 ; extract digit 00F587 1 95 00 sta $00,X ; save unpacked form 00F589 1 A5 43 lda TEMPB ; reload lower byte 00F58B 1 66 42 ror TEMPA ; 2-byte 3-bit rotate 00F58D 1 6A ror A 00F58E 1 66 42 ror TEMPA 00F590 1 6A ror A 00F591 1 66 42 ror TEMPA 00F593 1 6A ror A 00F594 1 E8 inx ; next digit 00F595 1 88 dey ; Y is a counter 00F596 1 D0 EB bne UNLOOP ; round again 00F598 1 60 rts ; and return 00F599 1 A9 1F DISRAN: lda #$1F ; set single scan 00F59B 1 85 0E sta REPEAT 00F59D 1 20 0C FE DESCAN: jsr DISPLAY ; monitor scan call 00F5A0 1 49 1F eor #$1F ; key ? 00F5A2 1 D0 11 bne KEYFO ; yes 00F5A4 1 A5 24 lda RAN+2 ; generate random 00F5A6 1 29 42 and #TEMPA ; numbers, next bit in 00F5A8 1 69 3E adc #STRT+1 ; bit six of A 00F5AA 1 0A asl A ; and put in carry 00F5AB 1 0A asl A 00F5AC 1 26 22 rol RAN ; now rotate the bits 00F5AE 1 26 23 rol RAN+1 ; round the 3 bytes 00F5B0 1 26 24 rol RAN+2 00F5B2 1 4C 9D F5 jmp DESCAN ; and round again 00F5B5 1 90 01 KEYFO: bcc NORET ; cont or key ? 00F5B7 1 60 rts ; yes so return 00F5B8 1 A5 3F NORET: lda ANSWER ; digit key so 00F5BA 1 0A asl A ; assemble new answer 00F5BB 1 0A asl A ; last digit up 4 bits 00F5BC 1 0A asl A 00F5BD 1 0A asl A 00F5BE 1 05 0D ora KEY ; put in new digit 00F5C0 1 85 3F sta ANSWER ; store in ANSWER 00F5C2 1 20 60 FE jsr RDHEXTD ; A to display 00F5C5 1 4C 9D F5 jmp DESCAN ; and round again 00F5C8 1 A9 FF MSSAGE: lda #$FF ; message to display 00F5CA 1 85 0E sta REPEAT ; set scan mode for QOCTFE 00F5CC 1 86 20 stx MESSPO ; setup pointer 00F5CE 1 A0 07 ldy #$07 ; 8 digits to fetch 00F5D0 1 B1 20 MLOOP: lda (MESSPO),Y ; post index fetch 00F5D2 1 99 10 00 sta D,Y ; put in display buffer 00F5D5 1 88 dey ; next digit 00F5D6 1 10 F8 bpl MLOOP ; round again 00F5D8 1 60 SUBRET: rts ; or return 00F5D9 1 20 F3 F5 QOCTFE: jsr QOCTTD ; display old 00F5DC 1 20 0C FE jsr DISPLAY ; MONITOR scan call 00F5DF 1 B0 F7 bcs SUBRET ; control key return 00F5E1 1 A0 03 ldy #$03 ; 3 bits to shift 00F5E3 1 29 07 and #$07 ; keys range 0 to 7 00F5E5 1 16 01 SHIFT: asl $01,X ; this is the 3 00F5E7 1 36 00 rol $00,X ; bit shift 00F5E9 1 88 dey 00F5EA 1 D0 F9 bne SHIFT 00F5EC 1 15 01 ora $01,X ; put new key in 00F5EE 1 95 01 sta $01,X ; store new entry 00F5F0 1 4C D9 F5 jmp QOCTFE ; and round again 00F5F3 1 A0 04 QOCTTD: ldy #$04 ; 4 octal 00F5F5 1 B5 00 lda $00,X ; digits to display 00F5F7 1 85 42 sta TEMPA ; use TEMPA and TEMPB 00F5F9 1 B5 01 lda $01,X 00F5FB 1 85 43 DISLOP: sta TEMPB ; save lower byte 00F5FD 1 29 07 and #$07 ; mask digit 00F5FF 1 20 7A FE jsr HEXTD ; digit to display buffer 00F602 1 A5 43 lda TEMPB ; reload lower byte 00F604 1 66 42 ror TEMPA ; now 3-bit 2-byte 00F606 1 6A ror A ; rotate 00F607 1 66 42 ror TEMPA 00F609 1 6A ror A 00F60A 1 66 42 ror TEMPA 00F60C 1 6A ror A 00F60D 1 88 dey ; next digit 00F60E 1 D0 EB bne DISLOP ; and round again 00F610 1 60 rts ; or return 00F611 1 A9 FF MBEGIN: lda #$FF 00F613 1 85 22 sta RAN 00F615 1 A9 44 MstaRT: lda #$44 ; reset stack end 00F617 1 85 40 sta GSEND 00F619 1 A9 03 lda #$03 ; set mess pointer 00F61B 1 85 21 sta MESSPO+1 00F61D 1 A2 A7 ldx #$A7 ; message ready 00F61F 1 20 C8 F5 jsr MSSAGE 00F622 1 20 99 F5 jsr DISRAN ; display ready 00F625 1 A5 23 lda RAN+1 ; put random number 00F627 1 85 26 sta MYNO+1 ; as my number 00F629 1 A5 22 lda RAN 00F62B 1 29 0F and #$0F 00F62D 1 85 25 sta MYNO 00F62F 1 A2 C2 YOUGO: ldx #$C2 ; clear display 00F631 1 20 C8 F5 jsr MSSAGE 00F634 1 A9 FF lda #$FF ; set scan mode 00F636 1 85 0E sta REPEAT 00F638 1 A2 27 ldx #YGU ; fetch your guess 00F63A 1 20 D9 F5 jsr QOCTFE 00F63D 1 A2 29 ldx #NUMA ; num number to NUMA 00F63F 1 A0 25 ldy #MYNO 00F641 1 20 79 F5 jsr UNPACK 00F644 1 A2 2D ldx #NUMB ; your number to NUMB 00F646 1 A0 27 ldy #YGU 00F648 1 20 79 F5 jsr UNPACK 00F64B 1 20 45 F5 jsr MATCH ; and compare them 00F64E 1 C9 40 cmp #GSEND ; four bulls !!? 00F650 1 D0 18 bne NOWIN ; phew !! 00F652 1 A2 B4 ldx #$B4 ; drat you 00F654 1 20 C8 F5 ENDOUT: jsr MSSAGE ; end of game 00F657 1 20 99 F5 jsr DISRAN ; display message 00F65A 1 A2 C2 ldx #$C2 ; clear display 00F65C 1 20 C8 F5 jsr MSSAGE 00F65F 1 A2 25 ldx #MYNO 00F661 1 20 F3 F5 jsr QOCTTD 00F664 1 20 99 F5 jsr DISRAN 00F667 1 4C DF FE jmp START ; ready to play again 00F66A 1 20 60 FE NOWIN: jsr RDHEXTD ; MONITOR A to display 00F66D 1 20 99 F5 jsr DISRAN ; display bulls/cows 00F670 1 A5 22 lda RAN ; random number is my guess 00F672 1 29 0F and #$0F ; and rememeber where we are 00F674 1 85 3B sta MYGU ; start 00F676 1 85 3D sta STRT 00F678 1 A5 23 lda RAN+1 00F67A 1 85 3C sta MYGU+1 00F67C 1 85 3E sta STRT+1 00F67E 1 A0 3B NEWGU: ldy #MYGU 00F680 1 A2 2D ldx #NUMB ; unpacked to NUMB 00F682 1 20 79 F5 jsr UNPACK 00F685 1 A0 44 ldy #$44 ; reset guess pointer 00F687 1 C4 40 NEWINF: cpy GSEND ; end of stack ? 00F689 1 84 41 sty GUNO ; store guess pointer 00F68B 1 F0 30 beq FOUND ; yes stack finished 00F68D 1 A2 29 ldx #NUMA ; stacked guess 00F68F 1 20 79 F5 jsr UNPACK ; unpacked to NUMA 00F692 1 20 45 F5 jsr MATCH ; compare new answer 00F695 1 A4 41 ldy GUNO ; with old answers 00F697 1 D9 02 00 cmp $0002,Y 00F69A 1 D0 05 bne NOGOOD ; does not fit 00F69C 1 C8 iny ; next stack entry 00F69D 1 C8 iny 00F69E 1 C8 iny 00F69F 1 D0 E6 bne NEWINF ; try this entry 00F6A1 1 E6 3C NOGOOD: inc MYGU+1 ; increment 00F6A3 1 D0 08 bne NOTUP ; my guess as the last 00F6A5 1 E6 3B inc MYGU ; one was no good 00F6A7 1 A5 3B lda MYGU 00F6A9 1 29 0F and #$0F 00F6AB 1 85 3B sta MYGU 00F6AD 1 A5 3C NOTUP: lda MYGU+1 ; if we count 00F6AF 1 C5 3E cmp STRT+1 ; round to the start 00F6B1 1 D0 CB bne NEWGU ; then somebody is 00F6B3 1 A5 3B lda MYGU ; cheating otherwise 00F6B5 1 C5 3D cmp STRT ; try this new guess 00F6B7 1 D0 C5 bne NEWGU 00F6B9 1 A2 BC ldx #$BC ; you rotter 00F6BB 1 D0 97 bne ENDOUT ; end of game 00F6BD 1 A5 3B FOUND: lda MYGU ; put this good 00F6BF 1 99 00 00 sta $0000,Y ; on the stack 00F6C2 1 A5 3C lda MYGU+1 00F6C4 1 99 01 00 sta $0001,Y 00F6C7 1 A2 C4 ldx #$C4 ;"......__“ to display 00F6C9 1 20 C8 F5 jsr MSSAGE 00F6CC 1 A2 3B ldx #MYGU ; my guess to display 00F6CE 1 20 F3 F5 jsr QOCTTD 00F6D1 1 20 99 F5 jsr DISRAN ; use DISRAN to get answer 00F6D4 1 A5 3F lda ANSWER 00F6D6 1 C9 40 cmp #GSEND ; 4 bulls ? I win 00F6D8 1 D0 05 bne NOIWIN ; no not yet I don't 00F6DA 1 A2 AD ldx #$AD ; message and end game 00F6DC 1 4C 54 F6 jmp ENDOUT 00F6DF 1 A4 41 NOIWIN: ldy GUNO ; put answer on stack 00F6E1 1 99 02 00 sta $0002,Y 00F6E4 1 C8 iny ; update stack end 00F6E5 1 C8 iny 00F6E6 1 C8 iny 00F6E7 1 84 40 sty GSEND 00F6E9 1 4C 2F F6 jmp YOUGO ; and round again 00F6EC 1 ; 00F6EC 1 00 50 79 77 READY: .byte $00,$50,$79,$77,$5E,$6E 00F6F0 1 5E 6E 00F6F2 1 00 00 06 00 IWIN: .byte $00,$00,$06,$00,$1C,$04,$54 00F6F6 1 1C 04 54 00F6F9 1 00 6E 3F 3E YOUWIN: .byte $00,$6E,$3F,$3E,$00,$1C,$04,$54 00F6FD 1 00 1C 04 54 00F701 1 00 39 76 79 MCHEAT: .byte $00,$39,$76,$79,$77,$78 00F705 1 77 78 00F707 1 00 00 BLANK: .byte $00,$00 00F709 1 00 00 00 00 PROMPT: .byte $00,$00,$00,$00,$00,$00,$08,$08 00F70D 1 00 00 08 08 00F711 1 ; 00F711 1 ; *** COUNTER KEYBOARD *** 00F711 1 ; 00F711 1 COUNT := $19 00F711 1 ; 00F711 1 20 0C FE DISP: jsr DISPLAY ; look for key 00F714 1 90 0A bcc CHANGE ; check if control key carry set if so 00F716 1 C9 17 cmp #$17 00F718 1 F0 1F beq DOWN1 00F71A 1 C9 16 cmp #$16 00F71C 1 F0 11 beq UP1 00F71E 1 D0 F1 bne DISP 00F720 1 C9 00 CHANGE: cmp #$00 00F722 1 85 79 sta $79 00F724 1 F0 EB MORE: beq DISP ; increment No. of times of TEY 00F726 1 20 54 F7 jsr INCR 00F729 1 C6 79 dec $79 00F72B 1 10 F7 bpl MORE 00F72D 1 30 E2 bmi DISP 00F72F 1 20 54 F7 UP1: jsr INCR ; rapid increment 00F732 1 20 43 F7 jsr ZOOM 00F735 1 D0 DA bne DISP 00F737 1 F0 F6 beq UP1 00F739 1 20 5D F7 DOWN1: jsr DECR ; rapid decrement 00F73C 1 20 43 F7 jsr ZOOM 00F73F 1 D0 D0 bne DISP 00F741 1 F0 F6 beq DOWN1 00F743 1 A9 1F ZOOM: lda #$1F 00F745 1 85 0E sta $0E ; set for one scan only 00F747 1 20 0C FE jsr DISPLAY 00F74A 1 90 03 bcc STOP ; check if key depressed claer if one is 00F74C 1 A9 00 lda #$00 00F74E 1 60 rts 00F74F 1 A9 FF STOP: lda #$FF ; reset so that jsr DISPLAY waits for input 00F751 1 85 0E sta $0E 00F753 1 60 rts 00F754 1 ; 00F754 1 ; *** COUNTER KEYBOARD SUBROUTINE *** 00F754 1 ; 00F754 1 CNTL := $1A 00F754 1 CNTH := $1B 00F754 1 ; 00F754 1 E6 7A INCR: inc $7A 00F756 1 D0 0D bne UPDATE 00F758 1 E6 7B inc $7B 00F75A 1 38 sec 00F75B 1 B0 08 bcs UPDATE 00F75D 1 A5 7A DECR: lda $7A 00F75F 1 D0 02 bne NOT 00F761 1 C6 7B dec $7B 00F763 1 C6 7A NOT: dec $7A 00F765 1 A2 7A UPDATE: ldx #$7A 00F767 1 20 64 FE jsr QHEXTD1 00F76A 1 60 rts 00F76B 1 ; 00F76B 1 ; *** METRONOME *** 00F76B 1 ; 00F76B 1 PERIOD := $20 00F76B 1 CLRPA6 := $0E06 ; clear bit 6 of PIA 00F76B 1 SETPA6 := $0E16 ; set bit 6 of PIA 00F76B 1 ; 00F76B 1 A9 1F METRO: lda #$1F 00F76D 1 85 0E sta REPEAT ; set display to single scan 00F76F 1 A9 40 PULSE: lda #$40 00F771 1 8D 22 0E sta ADDR ; define PA6 as output 00F774 1 8D 16 0E sta SETPA6 ; use the INS8154 set bit mode 00F777 1 20 CD FE jsr WAIT ; use the 300 baud wait 00F77A 1 8D 06 0E sta CLRPA6 ; use the INS8154 clear bit mode 00F77D 1 A6 20 ldx PERIOD 00F77F 1 20 0C FE DEL2: jsr DISPLAY ; look at keyboard 00F782 1 C9 16 cmp #$16 ; up key ? 00F784 1 D0 04 bne DOWN2 ; no 00F786 1 E6 20 inc PERIOD ; decrease PERIOD 00F788 1 B0 E5 bcs PULSE ; carry was set by the compare: always 00F78A 1 C9 17 DOWN2: cmp #$17 ; down key ? 00F78C 1 D0 04 bne DELI ; no 00F78E 1 C6 20 dec PERIOD ; decrease PERIOD 00F790 1 B0 DD bcs PULSE ; carry was set by the compare: always 00F792 1 A0 0C DELI: ldy #$0C ; cycle time of u1/2 seconds 00F794 1 20 CD FE DELJ: jsr WAIT 00F797 1 88 dey 00F798 1 10 FA bpl DELJ 00F79A 1 CA dex 00F79B 1 D0 E2 bne DEL2 00F79D 1 F0 D0 beq PULSE ; end of this period so pulse 00F79F 1 ; 00F79F 1 ; *** EIGHT QUEENS PROBLEM *** 00F79F 1 ; 00F79F 1 ROW := $20 00F79F 1 LEFT := $29 00F79F 1 RIGHT := $32 00F79F 1 ; 00F79F 1 F8 QUEENS: sed 00F7A0 1 A2 20 ldx #$20 00F7A2 1 84 19 sty COUNT ; clear count 00F7A4 1 84 20 sty ROW ; clear row occupied 00F7A6 1 84 29 sty LEFT ; clear left diagonal attacks 00F7A8 1 84 32 sty RIGHT ; clear right diagonal attacks 00F7AA 1 20 B5 F7 jsr TRY2 ; find the No. of ways 00F7AD 1 A5 19 lda COUNT 00F7AF 1 20 60 FE jsr RDHEXTD ; display answer 00F7B2 1 4C 04 FF jmp RESTART 00F7B5 1 B5 00 TRY2: lda $00,x ; finished yet ? 00F7B7 1 C9 FF cmp #$FF 00F7B9 1 D0 07 bne CONTIN 00F7BB 1 A5 19 lda COUNT ; finished, so increment count 00F7BD 1 69 00 adc #$00 00F7BF 1 85 19 sta COUNT 00F7C1 1 60 FINISH: rts 00F7C2 1 15 09 CONTIN: ora $09,x ; current left 00F7C4 1 15 12 ora $12,x ; current right 00F7C6 1 A8 LOOP5: tay 00F7C7 1 49 FF eor #$FF 00F7C9 1 F0 F6 beq FINISH ; no chance 00F7CB 1 95 1B sta $1B,x ; current possible place 00F7CD 1 C8 iny 00F7CE 1 98 tya 00F7CF 1 35 1B and $1B,x 00F7D1 1 A8 tay 00F7D2 1 15 00 ora $00,x 00F7D4 1 95 01 sta $01,x ; new row 00F7D6 1 98 tya 00F7D7 1 15 09 ora $09,x 00F7D9 1 0A asl A 00F7DA 1 95 0A sta $0A,x ; new left attack 00F7DC 1 98 tya 00F7DD 1 15 12 ora $12,x 00F7DF 1 4A lsr A 00F7E0 1 95 13 sta $13,x ; new right attack 00F7E2 1 E8 inx 00F7E3 1 20 B5 F7 jsr TRY2 00F7E6 1 CA dex 00F7E7 1 B5 01 lda $01,x 00F7E9 1 49 FF eor #$FF 00F7EB 1 35 1B and $1B,x 00F7ED 1 49 FF eor #$FF 00F7EF 1 4C C6 F7 jmp LOOP5 00F7F2 1 ; 00F7F2 1 ; *** 'Acorn 1' *** (by mikes on Stardot) 00F7F2 1 ; 00F7F2 1 A2 07 ACORN1: ldx #$07 00F7F4 1 BD 02 F8 LOOP6: lda MESAGE,X 00F7F7 1 95 10 sta D,X 00F7F9 1 CA dex 00F7FA 1 10 F8 bpl LOOP6 00F7FC 1 20 0C FE jsr DISPLAY 00F7FF 1 4C FB FE jmp INIT 00F802 1 ; 00F802 1 00 77 58 5C MESAGE: .byte $00,$77,$58,$5c,$50,$54,$00,$30 00F806 1 50 54 00 30 00F80A 1 ; 00F80A 1 ; Fill space with FF's 00F80A 1 ; 00F80A 1 .listbytes 4 00F80A 1 FF FF FF FF .repeat $5F4 00FDFE 1 .byte $FF 00FDFE 1 .endrep 00FDFE 1 FF .byte $FF 00FDFF 1 .listbytes unlimited 00FDFF 1 ; 00FDFF 1 ; *** Acorn System 1 'Monitor' *** 00FDFF 1 ; 00FDFF 1 .org $FE00 00FE00 1 ; 00FE00 1 A0 06 QUAD: ldy #$06 ; display the 4-bytes at X-3, X-2, 00FE02 1 ; X-1 & X in that order on the display 00FE02 1 B5 00 STILL: lda 0,X ; get the byte pointed to by X 00FE04 1 20 6F FE jsr DHEXTD ; use double hex to display routine 00FE07 1 CA dex ; next X 00FE08 1 88 dey ; next Y position 00FE09 1 88 dey 00FE0A 1 10 F6 bpl STILL ; fall auto display when finished - Y position 00FE0C 1 ; & also loop counter 00FE0C 1 ; 00FE0C 1 86 1A DISPLAY:stx TX ; save X!!!! 00FE0E 1 A2 07 RESCAN: ldx #$07 ; scan 8 digits, no matter what 00FE10 1 8E 22 0E stx ADDR ; set up data direction register 00FE13 1 A0 00 SCAN: ldy #$00 ; clear Y for later use 00FE15 1 B5 10 lda D,X ; get display data from the zero page memory 00FE17 1 8D 21 0E sta PIB ; & put it onto segments 00FE1A 1 8E 20 0E stx PIA ; set digit drive on and the key columns 00FE1D 1 AD 20 0E lda PIA ; get key digit back 00FE20 1 29 3F and #$3F ; remove surplus top bits 00FE22 1 24 0F bit EXEC ; check status ='1' means not processing a key 00FE24 1 10 18 bpl BUTTON ; but 0 means that we are thus can be blown to an 00FE26 1 ; escape from the display routine altogther on status 00FE26 1 ; C0 at the moment it ignores keys if given this status 00FE26 1 C9 38 cmp #$38 ; check for all 1's row input 00FE28 1 ; from keyboard = set copy if so 00FE28 1 B0 06 bcs DELAY ; if all 1's then no key has been pressed 00FE2A 1 86 19 stx COL ; store the pressed key's column information 00FE2C 1 A9 40 lda #$40 ; set status to "we are processing a key" 00FE2E 1 85 0F KEYCLR: sta EXEC 00FE30 1 A1 00 DELAY: lda (0,X) 00FE32 1 88 dey ; Y was zero so here is a 256x5uS delay 00FE33 1 D0 FB bne DELAY ; Y will be zero on exit 00FE35 1 CA dex 00FE36 1 10 DB bpl SCAN ; if X was still +ve, continue this scan 00FE38 1 A5 0E lda REPEAT ; if we should continue scanning then top bit is set 00FE3A 1 30 D2 bmi RESCAN ; continue scanning 00FE3C 1 10 14 bpl OUTPUT ; if top bit is zero, then use this data as the key itself 00FE3E 1 E4 19 BUTTON: cpx COL ; are we on the same key's column ? 00FE40 1 D0 EE bne DELAY ; no 00FE42 1 C9 38 cmp #$38 ; has a key actually been pressed ? 00FE44 1 90 04 bcc PRESSED ; yes 00FE46 1 A9 80 lda #$80 ; no, then clear the execution status - 00FE48 1 ; the key has been pressed & released 00FE48 1 D0 E4 bne KEYCLR ; always branch 00FE4A 1 C5 0F PRESSED:cmp EXEC ; a key has been pressed 00FE4C 1 F0 E2 beq DELAY ; but it has already been executed 00FE4E 1 85 0F sta EXEC ; set it as being executed 00FE50 1 49 38 eor #$38 ; jiggery pokery to encode the row inputs to binary 00FE52 1 29 1F OUTPUT: and #$1F ; also ensure the key in repeat was of reasonable size 00FE54 1 C9 10 cmp #$10 ; a hex key or not ? carry clear if hex 00FE56 1 85 0D sta KEY ; put the key in a temp location for further use (by "modify") 00FE58 1 A6 1A ldx TX ; retrieve X 00FE5A 1 8C 21 0E sty PIB ; turn the segment drives off 00FE5D 1 60 rts ; and return 00FE5E 1 00FE5E 1 A1 00 MHEXTD: lda (0,X) ; Memory HEX To Display = get a byte from memory 00FE60 1 A0 06 RDHEXTD:ldy #$06 ; right (of display) double hex 00FE62 1 ; to display :set Y to right of display 00FE62 1 D0 0B bne DHEXTD ; and use DHEXTD 00FE64 1 ; 00FE64 1 A0 03 QHEXTD1:ldy #$03 ; Quad HEX To Display 1: set Y to use posns 1,2,3 & 4 00FE66 1 ; 00FE66 1 B5 00 QHEXTD2:lda 0,X ; Quad HEX To Display 2: use any Y: get the data 00FE68 1 20 6F FE jsr DHEXTD ; and use DHEXTD 00FE6B 1 88 dey 00FE6C 1 88 dey ; having decremented the position 00FE6D 1 B5 01 lda 1,X ; get the high byte of the data & use DHEXTD 00FE6F 1 ; 00FE6F 1 C8 DHEXTD: iny ; Double HEX To Display :first hex on rightest position 00FE70 1 48 pha ; save A 00FE71 1 20 7A FE jsr HEXTD ; use hex to display 00FE74 1 88 dey ; get Y back to correct position 00FE75 1 68 pla ; retrieve A 00FE76 1 4A lsr A 00FE77 1 4A lsr A 00FE78 1 4A lsr A 00FE79 1 4A lsr A ; orientated for other hex digit 00FE7A 1 ; 00FE7A 1 84 1A HEXTD: sty TY ; HEX To Display = save Y 00FE7C 1 29 0F and #$0F ; remove surplus bits from A 00FE7E 1 A8 tay ; & put it in Y 00FE7F 1 B9 EA FF lda FONT,Y ; get the 7-segment form 00FE82 1 A4 1A ldy TY ; retrieve Y 00FE84 1 99 10 00 sta D,Y ; and position the 7-segment form on the display 00FE87 1 60 rts 00FE88 1 ; 00FE88 1 20 64 FE QDATFET:jsr QHEXTD1 ; Quad DATa FETch - display old data 00FE8B 1 20 0C FE jsr DISPLAY ; get key 00FE8E 1 B0 20 bcs RETURN ; non hex return 00FE90 1 A0 04 ldy #$04 ; loop counter 00FE92 1 0A asl A 00FE93 1 0A asl A 00FE94 1 0A asl A 00FE95 1 0A asl A ; digit in A in correct place 00FE96 1 0A SHIFTIN:asl A ; multi-shift to get digit into memory 00FE97 1 36 00 rol 0,X ; indexed 00FE99 1 36 01 rol 1,X 00FE9B 1 88 dey 00FE9C 1 D0 F8 bne SHIFTIN ; keep shifting in 00FE9E 1 F0 E8 beq QDATFET ; go and do it all again 00FEA0 1 ; 00FEA0 1 F6 06 COM16: inc $06,X ; increment & COMpare 16-bit numbers - increment lower 00FEA2 1 D0 02 bne NOINC ; no high increment 00FEA4 1 F6 07 inc $07,X 00FEA6 1 B5 06 NOINC: lda $06,X ; low byte equality test 00FEA8 1 D5 08 cmp $08,X 00FEAA 1 D0 04 bne RETURN ; no need to do high byte 00FEAC 1 B5 07 lda $07,X ; high byte equality test 00FEAE 1 D5 09 cmp $09,X 00FEB0 1 60 RETURN: rts 00FEB1 1 00FEB1 1 A0 40 PUTBYTE:ldy #$40 ; PUT BYTE to tape - configure i/o port 00FEB3 1 8C 22 0E sty ADDR 00FEB6 1 A0 07 ldy #$07 ; loop counter 00FEB8 1 8C 20 0E sty PIA ; and send the start bit 00FEBB 1 6A ror A 00FEBC 1 6A ror A ; back up a couple of bits 00FEBD 1 20 CD FE AGAIN: jsr WAIT ; wait to send out reset bit 00FEC0 1 6A ror A ; sending order is bit 0 -> bit 7 00FEC1 1 8D 20 0E sta PIA ; send bit 00FEC4 1 88 dey 00FEC5 1 10 F6 bpl AGAIN ; keep going 00FEC7 1 20 CD FE jsr WAIT ; wait for that bit to end 00FECA 1 8C 20 0E sty PIA ; send stop bit : Y is FF 00FECD 1 ; 00FECD 1 20 D0 FE WAIT: jsr HAFWAIT ; 300 baud WAITing time - in two parts 00FED0 1 ; 00FED0 1 84 1A HAFWAIT:sty TY ; HAlF the WAITing time - save Y 00FED2 1 A0 48 ldy #$48 ; 72 X 5uS delay 00FED4 1 88 WAIT3: dey ; part one of the wait 00FED5 1 D0 FD bne WAIT3 00FED7 1 88 WAIT4: dey ; Y was zero on entry - 256 x 5uS delay 00FED8 1 D0 FD bne WAIT4 00FEDA 1 A4 1A ldy TY ; retrieve Y 00FEDC 1 60 rts 00FEDD 1 00FEDD 1 A0 08 GETBYTE:ldy #$08 ; GET BYTE from tape - load counter 00FEDF 1 2C 20 0E START: bit PIA ; wait for 1 -> 0 transition - a start bit 00FEE2 1 30 FB bmi START 00FEE4 1 20 D0 FE jsr HAFWAIT ; wait half the time, so sampling in the centre 00FEE7 1 20 CD FE INPUT: jsr WAIT ; full wait time between samples 00FEEA 1 0E 20 0E asl PIA ; get sample into carry 00FEED 1 6A ror A ; and auto A 00FEEE 1 88 dey 00FEEF 1 D0 F6 bne INPUT ; keep going 00FEF1 1 F0 DA beq WAIT ; use wait to get out onto the stop bit high 00FEF3 1 A2 FF RESET: ldx #$FF ; MAIN PROGRAM 00FEF5 1 9A txs ; initialise stack 00FEF6 1 8E 23 0E stx BDDR ; and B data direction register 00FEF9 1 86 0E stx REPEAT ; multi-scan display mode 00FEFB 1 A0 80 INIT: ldy #$80 ; the familiar dot on the display 00FEFD 1 A2 09 ldx #$09 ; all eight displays and initialise exec 00FEFF 1 94 0E ROUND: sty REPEAT,X ; Y used for amusement 00FF01 1 CA dex 00FF02 1 D0 FB bne ROUND ; X zero on exit, so up & down immediately valid 00FF04 1 ; 00FF04 1 20 0C FE RESTART:jsr DISPLAY ; mark return to monitor point display & get key 00FF07 1 90 F2 REENTER:bcc INIT ; hex key gets the dots back 00FF09 1 29 07 SEARCH: and #$07 ; remove any stray bits (effectively subtract 10) 00FF0B 1 C9 04 cmp #$04 00FF0D 1 90 25 bcc FETADD ; keys of value less than 4 need an address 00FF0F 1 F0 6F beq LOAD ; key 4 is the load key 00FF11 1 C9 06 TEST6: cmp #$06 00FF13 1 F0 09 beq UP ; key 6 is up 00FF15 1 B0 0F bcs DOWN ; & key 7 is down 00FF17 1 A5 0A RETURN2:lda R0 ; must be key 5 - gat A back 00FF19 1 A6 0B ldx R1 ; get X back 00FF1B 1 A4 0C ldy R2 ; get Y back 00FF1D 1 40 rti ; get P & PC back & continue from where you were 00FF1E 1 F6 00 UP: inc 0,X ; 16-bit indexed increment 00FF20 1 D0 0C bne ENTERM 00FF22 1 F6 01 inc 1,X 00FF24 1 B0 08 bcs ENTERM ; a branch always: the carry was set by the FF11 compare 00FF26 1 B5 00 DOWN: lda 0,X ; 16-bit indexed decrement 00FF28 1 D0 02 bne NODEC 00FF2A 1 D6 01 dec 1,X 00FF2C 1 D6 00 NODEC: dec 0,X 00FF2E 1 20 64 FE ENTERM: jsr QHEXTD1 ; now display the value 00FF31 1 4C 45 FF jmp MODIFY ; and get into the modify section 00FF34 1 84 16 FETADD: sty D+6 ; clear displays 6 00FF36 1 84 17 sty D+7 ; & 7 - Y was zero on exit from DISPLAY 00FF38 1 0A asl A ; double A 00FF39 1 AA tax ; the zero page addresses MAP, GAP, PAP & FAP 00FF3A 1 49 F7 eor #$F7 ; fix up digit 0 command symbol 00FF3C 1 85 10 sta D 00FF3E 1 20 88 FE jsr QDATFET ; fetch the address, into MAP, GAP, PAP OR FAP 00FF41 1 E0 02 cpx #$02 ; check X to find out which command we're doing 00FF43 1 B0 15 bcs N1 ; must be 2,4 or 6 - as 0 is 00FF45 1 20 5E FE MODIFY: jsr MHEXTD ; display the memory 00FF48 1 20 0C FE jsr DISPLAY ; and get key 00FF4B 1 B0 BC bcs SEARCH ; if not hex do over 00FF4D 1 A1 00 lda (0, X) ; hex so get old info 00FF4F 1 0A asl A 00FF50 1 0A asl A 00FF51 1 0A asl A 00FF52 1 0A asl A ; moved along 00FF53 1 05 0D ora KEY ; and put in new info 00FF55 1 81 00 sta (0, X) ; and put it back 00FF57 1 4C 45 FF jmp MODIFY ; then keep doing it 00FF5A 1 D0 03 N1: bne N2 ; must be 4 or 6 as 2 is .. 00FF5C 1 6C 02 00 GO: jmp (GAP) ; the very simple go 00FF5F 1 E0 04 N2: cpx #$04 ; is it 4 or 6 ? 00FF61 1 F0 36 beq POINT ; well it's not 4 00FF63 1 A2 08 STORE: ldx #$08 ; so it must be 6 - X now points to TAP 00FF65 1 86 10 stx D ; give prompt 00FF67 1 20 88 FE jsr QDATFET ; and get 2nd store info 00FF6A 1 A2 04 ldx #$04 ; loop count 00FF6C 1 B5 05 ADDRESS:lda $05,X ; send addresses to tape 00FF6E 1 20 B1 FE jsr PUTBYTE 00FF71 1 CA dex 00FF72 1 D0 F8 bne ADDRESS ; X neatly zeroed on exit 00FF74 1 A1 06 DATAS: lda ($06,X) ; data send - get info from memory 00FF76 1 20 B1 FE jsr PUTBYTE ; and send it to tape 00FF79 1 20 A0 FE jsr COM16 ; see if printed 00FF7C 1 D0 F6 bne DATAS ; no 00FF7E 1 F0 2A beq WAYOUT ; yes 00FF80 1 A2 04 LOAD: ldx #$04 00FF82 1 20 DD FE ADDRSL: jsr GETBYTE ; rescue addresses from tape 00FF85 1 95 05 sta $05,X ; put them in FAP & TAP, though it could be elsewhere 00FF87 1 CA dex 00FF88 1 D0 F8 bne ADDRSL ; X neatly served again 00FF8A 1 20 DD FE DATAL: jsr GETBYTE ; get data from tape 00FF8D 1 81 06 sta ($06,X) ; and store it in memory 00FF8F 1 8D 21 0E sta PIB ; and on the display so it can be seen 00FF92 1 20 A0 FE jsr COM16 ; see if finished 00FF95 1 D0 F3 bne DATAL ; no 00FF97 1 F0 11 beq WAYOUT ; yes 00FF99 1 A1 00 POINT: lda (0,X) ; set/clear breakpoint - get data from addressed memory 00FF9B 1 F0 06 beq SET ; if zero breakpoint has already been set = must clear it 00FF9D 1 85 18 sta P ; not zero so save the information 00FF9F 1 A9 00 lda #$00 ; and put in a breakpoint 00FFA1 1 F0 02 beq OUT 00FFA3 1 A5 18 SET: lda P ; was set so get old information back 00FFA5 1 81 00 OUT: sta ($00,X) ; insert breakpoint or old information 00FFA7 1 20 5E FE jsr MHEXTD ; now read it out again to reveal ROM 00FFAA 1 4C 04 FF WAYOUT: jmp RESTART ; go back & do it all over again 00FFAD 1 6C 1C 00 NMI: jmp (USERNMI) ; indirection on NMI 00FFB0 1 6C 1E 00 IRQ: jmp (USERIRQ) ; indirection on IRQ 00FFB3 1 85 0A BREAK: sta R0 ; when the IRQ/BRK vector points here then display everything 00FFB5 1 ; save A 00FFB5 1 86 0B stx R1 ; save X 00FFB7 1 84 0C sty R2 ; save Y 00FFB9 1 68 pla ; get P off stack 00FFBA 1 48 pha ; put it back for future use 00FFBB 1 85 0D sta R3 ; store Q in register 3 00FFBD 1 A2 0D ldx #R3 ; set X to point at registers 3 -> 0 for QUAD 00FFBF 1 A9 FF lda #$FF ; kill possibility of displaybeing on single scan 00FFC1 1 85 0E sta REPEAT 00FFC3 1 20 00 FE jsr QUAD ; use QUAD to write out A, X, Y and P 00FFC6 1 BA tsx ; get stack pointer 00FFC7 1 86 13 stx R7 00FFC9 1 C8 iny ; Y zero since QUAD ended with display so this forms 01 00FFCA 1 84 12 sty R6 00FFCC 1 D8 cld ; clear decimal mode for binary subtract - doesn't affect user since P is stacked 00FFCD 1 BD 02 01 lda STACK+2,X ; get PCL off stack 00FFD0 1 38 sec 00FFD1 1 E5 1B sbc RECAL ; correct it by amount in RECAL 00FFD3 1 9D 02 01 sta STACK+2,X ; put it back on stack 00FFD6 1 85 11 sta R5 ; and store it for QUAD 00FFD8 1 BD 03 01 lda STACK+3,X ; PCH off stack 00FFDB 1 E9 00 sbc #$00 ; rest of two byte subtraction 00FFDD 1 9D 03 01 sta STACK+3,X ; put it back on stack 00FFE0 1 85 10 sta R4 ; and store it for QUAD 00FFE2 1 A2 13 ldx #R7 ; point X at these registers - QUAD will destroy them 00FFE4 1 20 00 FE jsr QUAD ; QUAD writes out PC and SP 00FFE7 1 4C 07 FF jmp REENTER ; and the whole thing start over again 00FFEA 1 3F 06 5B 4F FONT: .byte $3F,$06,$5B,$4F ; '0'-'3' 00FFEE 1 66 6D 7D 07 .byte $66,$6D,$7D,$07 ; '4'-'7 00FFF2 1 7F 6F 77 7C .byte $7F,$6F,$77,$7C ; '8','9','A','b' 00FFF6 1 58 5E 79 71 .byte $58,$5E,$79,$71 ; 'c','d','E','F' 00FFFA 1 AD FF NMIVEC: .word NMI ; point to the added indirection 00FFFC 1 F3 FE RSTVEC: .word RESET ; point to the RESET entry point 00FFFE 1 B0 FF IRQVEC: .word IRQ ; point to the added indirection 00FFFE 1