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 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: $F1CD 00F000 1 ; Tape Programs TEST entry point: $F1FB 00F000 1 ; RETAG entry point: $F203 00F000 1 ; Scroll entry point: $F23B 00F000 1 ; VDU entry point: $F249 00F000 1 ; Acorn Keywrite entry point: $F333 00F000 1 ; Minidisassembler entry point: $F361 00F000 1 ; Games 00F000 1 ; Nim entry point: $F3D8 00F000 1 ; Duck Shoot entry point: $F48C 00F000 1 ; Bulls and Cows (Mastermind) entry point: $F598 (code starts at $F4CC) 00F000 1 ; Miscellanous 00F000 1 ; Counter Keyboard entry point: $F698 00F000 1 ; Keyboard Counter Subroutine entry point: $F6DB 00F000 1 ; Metronome entry point: $F6F2 00F000 1 ; Eight Queens Problem entry point: $F726 00F000 1 ; 'Acorn 1' entry point: $F779 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 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 51 lda #$51 00F19E 1 20 B2 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 57 TOOFAR: lda #$57 ; whoops 00F1AC 1 20 B2 F1 jsr MESSAGE ; tell the programmer that its wrong 00F1AF 1 4C 6E F1 jmp AGAIN2 00F1B2 1 85 20 MESSAGE:sta MESSL ; message described by A 00F1B4 1 A0 07 ldy #$07 ; eight bytes of data to display 00F1B6 1 B1 20 LOOP3: lda (MESSL),y ; fetch them 00F1B8 1 99 10 00 sta D,y 00F1BB 1 88 dey 00F1BC 1 10 F8 bpl LOOP3 00F1BE 1 60 rts 00F1BF 1 5C 71 71 ED .byte $5C,$71,$71,$ED,$79,$78,$78,$5C 00F1C3 1 79 78 78 5C 00F1C7 1 5C 00 71 77 .byte $5C,$00,$71,$77,$50,$00 00F1CB 1 50 00 00F1CD 1 ; 00F1CD 1 ; *** RELOCATOR *** 00F1CD 1 ; 00F1CD 1 A2 F1 RELOC: ldx #$F1 00F1CF 1 86 10 stx D ; setup from prompt F. 00F1D1 1 A2 20 ldx #$20 00F1D3 1 20 88 FE jsr QDATFET ; and get address 00F1D6 1 A2 46 ldx #$46 00F1D8 1 86 10 stx D ; setup end prompt 00F1DA 1 A2 22 ldx #$22 00F1DC 1 20 88 FE jsr QDATFET ; and get second address 00F1DF 1 A2 78 ldx #$78 ; move the data between these addresses 00F1E1 1 86 10 stx D ; setup prompt 00F1E3 1 A2 24 ldx #$24 00F1E5 1 20 88 FE jsr QDATFET ; and get base address 00F1E8 1 A2 1A ldx #$1A ; move to here & successive locations 00F1EA 1 A1 06 MOVE: lda ($06,x) ; do the move 00F1EC 1 91 24 sta ($24),y 00F1EE 1 C8 iny 00F1EF 1 D0 02 bne NOINC2 00F1F1 1 E6 25 inc $25 00F1F3 1 20 A0 FE NOINC2: jsr COM16 ; use COM16 to do the limit test 00F1F6 1 D0 F2 bne MOVE 00F1F8 1 4C 04 FF jmp RESTART 00F1FB 1 ; 00F1FB 1 ; *** TAPE USE PROGRAMS *** 00F1FB 1 ; 00F1FB 1 A9 55 TEST: lda #$55 ; the test byte 00F1FD 1 20 B1 FE jsr PUTBYTE ; send it 00F200 1 4C FB F1 jmp TEST ; keep sending it 00F203 1 ; 00F203 1 A9 F1 RETAG: lda #$F1 ; F. prompt 00F205 1 85 10 sta D 00F207 1 A2 06 ldx #$06 00F209 1 20 88 FE jsr QDATFET ; first address 00F20C 1 A2 08 ldx #$08 00F20E 1 86 10 stx D ; prompt 00F210 1 20 88 FE jsr QDATFET ; second address 00F213 1 A9 46 lda #$46 ; prompt 00F215 1 85 10 sta D 00F217 1 A2 20 ldx #$20 00F219 1 20 88 FE jsr QDATFET ; last address: actual data start 00F21C 1 A2 04 ldx #$04 00F21E 1 B5 05 ADRSS: lda $05,x ; send fake address 00F220 1 20 B1 FE jsr PUTBYTE 00F223 1 CA dex 00F224 1 D0 F8 bne ADRSS 00F226 1 A0 00 DATAS1: ldy #$00 00F228 1 B1 20 lda ($20),y ; proper data 00F22A 1 E6 20 inc $20 ; increment proper data counter 00F22C 1 D0 02 bne NOINC3 00F22E 1 E6 21 inc $21 00F230 1 20 B1 FE NOINC3: jsr PUTBYTE ; send data 00F233 1 20 A0 FE jsr COM16 ; check fake addresses for end 00F236 1 D0 EE bne DATAS1 00F238 1 4C 04 FF jmp RESTART 00F23B 1 ; 00F23B 1 ; *** SCROLL *** 00F23B 1 ; 00F23B 1 A2 00 SCROLL: ldx #$00 ; must go forwards 00F23D 1 B4 11 LOOP4: ldy D+1,x ; pick-up data on right 00F23F 1 94 10 sty D,x ; & move it one left 00F241 1 E8 inx 00F242 1 E0 07 cpx #$07 00F244 1 D0 F7 bne LOOP4 ; keep going 00F246 1 85 11 sta D+1 ; new data 00F248 1 60 rts 00F249 1 ; 00F249 1 ; *** VDU *** (from Teletext Board Technical Manual) 00F249 1 ; 00F249 1 LF := $0A ; LineFeed 00F249 1 FF := $0C ; FormFeed 00F249 1 CR := $0D ; Carriage Return 00F249 1 DEL := $7F ; DELete 00F249 1 SCAP := $20 00F249 1 LINE := $21 00F249 1 WORK := $23 00F249 1 SCRA := $0400 ; memory addresses for the screen 00F249 1 SCRB := $0500 00F249 1 SCRC := $0600 00F249 1 SCRD := $0700 00F249 1 CRTA := $0800 ; 6845 crt controller 00F249 1 CRTB := $0801 00F249 1 ; 00F249 1 VDU: 00F249 1 A4 20 CHATS: ldy SCAP ; CHAracter To Screen 00F24B 1 C9 20 cmp #$20 00F24D 1 90 37 bcc CTL ; all control characters 00F24F 1 C9 7F cmp #DEL 00F251 1 F0 27 beq DELETE 00F253 1 20 16 F3 TOSCRN: jsr WRCH 00F256 1 C8 iny 00F257 1 C0 28 cpy #$28 00F259 1 90 05 bcc VDUB ; automatic scroll when line filled 00F25B 1 20 3B F2 FILLED: jsr SCROLL 00F25E 1 A0 00 VDUA: ldy #$00 00F260 1 20 FE F2 VDUB: jsr CALCN 00F263 1 84 20 sty SCAP 00F265 1 A0 0F ldy #$0F ; rewrite cursor position 00F267 1 8C 00 08 sty CRTA 00F26A 1 A4 23 ldy WORK 00F26C 1 8C 01 08 sty CRTB 00F26F 1 A0 0E ldy #$0E 00F271 1 8C 00 08 sty CRTA 00F274 1 A4 25 ldy WORK+2 00F276 1 8C 01 08 sty CRTB 00F279 1 60 VDUC: rts 00F27A 1 00F27A 1 88 DELETE: dey 00F27B 1 30 FC bmi VDUC ; refuse to delete before line start 00F27D 1 A9 20 lda #$20 ; write in a blank 00F27F 1 20 16 F3 jsr WRCH 00F282 1 A9 7F lda #$7F 00F284 1 D0 DA bne VDUB 00F286 1 C9 0D CTL: cmp #CR ; carriage return ? 00F288 1 F0 D4 beq VDUA 00F28A 1 C9 0A cmp #LF ; linefeed ? 00F28C 1 F0 06 beq SCR 00F28E 1 C9 0C cmp #FF ; formfeed ? 00F290 1 F0 09 beq CLEARS 00F292 1 D0 BF bne TOSCRN 00F294 1 20 C9 F2 SCR: jsr SCROL ; scroll screen and rewrite cursor 00F297 1 A4 20 ldy SCAP 00F299 1 B0 C5 bcs VDUB 00F29B 1 48 CLEARS: pha ; clear entire buffer 00F29C 1 A0 00 ldy #$00 00F29E 1 A9 20 lda #$20 00F2A0 1 99 00 04 CLR: sta SCRA,y 00F2A3 1 99 00 05 sta SCRB,y 00F2A6 1 99 00 06 sta SCRC,y 00F2A9 1 99 00 07 sta SCRD,y 00F2AC 1 C8 iny 00F2AD 1 D0 F1 bne CLR 00F2AF 1 84 20 sty SCAP 00F2B1 1 A0 0F ldy #$0F 00F2B3 1 8C 00 08 SETCRT: sty CRTA ; set up all the crt parameters 00F2B6 1 B9 23 F3 lda CRTTAB,y 00F2B9 1 8D 01 08 sta CRTB 00F2BC 1 88 dey 00F2BD 1 10 F4 bpl SETCRT 00F2BF 1 A9 C0 lda #$C0 00F2C1 1 85 21 sta LINE 00F2C3 1 A9 07 lda #$07 00F2C5 1 85 22 sta LINE+1 00F2C7 1 68 pla 00F2C8 1 60 rts 00F2C9 1 ; 00F2C9 1 08 SCROL: php ; scroll subroutine 00F2CA 1 48 pha 00F2CB 1 D8 cld 00F2CC 1 A0 28 ldy #$28 00F2CE 1 20 FE F2 jsr CALCN 00F2D1 1 A5 23 lda WORK 00F2D3 1 85 21 sta LINE 00F2D5 1 A5 25 lda WORK+2 00F2D7 1 85 22 sta LINE+1 00F2D9 1 A0 0D ldy #$0D 00F2DB 1 8C 00 08 sty CRTA 00F2DE 1 A5 21 lda LINE 00F2E0 1 38 SEC 00F2E1 1 E9 C0 SBC #$C0 00F2E3 1 8D 01 08 sta CRTB 00F2E6 1 88 dey 00F2E7 1 8C 00 08 sty CRTA 00F2EA 1 A5 25 lda WORK+2 00F2EC 1 E9 03 SBC #$03 00F2EE 1 8D 01 08 sta CRTB 00F2F1 1 A0 27 ldy #$27 00F2F3 1 A9 20 lda #$20 00F2F5 1 20 16 F3 CLEARL: jsr WRCH 00F2F8 1 88 dey 00F2F9 1 10 FA bpl CLEARL 00F2FB 1 68 pla 00F2FC 1 28 plp 00F2FD 1 60 rts 00F2FE 1 00F2FE 1 08 CALCN: php ; do calculation to make sure that the 00F2FF 1 48 pha ; processor and crt controlier agree on 00F300 1 D8 cld ; position of screen 00F301 1 18 clc 00F302 1 98 tya 00F303 1 65 21 adc LINE 00F305 1 85 23 sta WORK 00F307 1 A5 22 lda LINE+1 00F309 1 69 00 adc #$00 00F30B 1 85 25 sta WORK+2 00F30D 1 29 07 and #$07 00F30F 1 09 04 ora #$04 00F311 1 85 24 sta WORK+1 00F313 1 68 pla 00F314 1 28 plp 00F315 1 60 rts 00F316 1 00F316 1 20 FE F2 WRCH: jsr CALCN 00F319 1 84 25 sty WORK+2 00F31B 1 A0 00 ldy #$00 00F31D 1 99 23 00 sta WORK,y 00F320 1 A4 25 ldy WORK+2 00F322 1 60 rts 00F323 1 ; 00F323 1 3F CRTTAB: .byte $3F ; total number of characters per line 00F324 1 28 .byte $28 ; 40 characters displayed 00F325 1 33 .byte $33 ; position of horizontal sync 00F326 1 05 .byte $05 ; width in uS of horizontal sync pulse 00F327 1 1E .byte $1E ; total number of character rows 00F328 1 02 .byte $02 ; additional no. of lines for 312 total 00F329 1 19 .byte $19 ; 25 displayed character rows 00F32A 1 18 .byte $18 ; position of vertical sync pulse 00F32B 1 00 .byte $00 ; set non-interlace mode 00F32C 1 09 .byte $09 ; set 10 lines per character row 00F32D 1 68 .byte $68 ; slow blink cursor from line 9 00F32E 1 09 .byte $09 ; to line 10 00F32F 1 04 .byte $04 ; high address of VDU ram 00F330 1 00 .byte $00 ; low address of VDU ram 00F331 1 07 .byte $07 ; high address of initial cursor position 00F332 1 C0 .byte $C0 ; low address of intial cursor position 00F333 1 ; 00F333 1 ; *** Acorn Keywrite *** (from Teletext Board Technical Manual) 00F333 1 ; 00F333 1 TEMP := $26 00F333 1 ; 00F333 1 20 0C FE KEYWRT: jsr DISPLAY 00F336 1 90 0E bcc SEND ; hex key ? 00F338 1 29 07 CONTRL: and #$07 00F33A 1 F0 1B beq RET 00F33C 1 A8 tay ; look up control keys in table 00F33D 1 B9 59 F3 lda TABLE-1,y 00F340 1 20 49 F2 SENDER: jsr CHATS 00F343 1 4C 33 F3 jmp KEYWRT 00F346 1 0A SEND: asl A 00F347 1 0A asl A 00F348 1 0A asl A 00F349 1 0A asl A 00F34A 1 85 26 sta TEMP 00F34C 1 20 0C FE jsr DISPLAY 00F34F 1 B0 E7 bcs CONTRL 00F351 1 05 26 ora TEMP ; mix in low digit 00F353 1 09 80 ora #$80 ; fool control character check 00F355 1 30 E9 bmi SENDER ; forced branch to SENDER 00F357 1 4C 04 FF RET: jmp RESTART ; M key returns to MONITOR 00F35A 1 20 TABLE: .byte $20 ; G key gives space bar 00F35B 1 20 .byte $20 ; P key gives space bar 00F35C 1 20 .byte $20 ; S key gives space bar 00F35D 1 0A .byte $0A ; L key gives linefeed 00F35E 1 0C .byte $0C ; R key gives formfeed 00F35F 1 7F .byte $7F ; key gives delete 00F360 1 0D .byte $0D ; key gives carriage return 00F361 1 ; 00F361 1 ; *** Minidisassembler *** (from Teletext Board Technical Manual) 00F361 1 ; 00F361 1 MOD := $00 00F361 1 COUNT1 := $0E 00F361 1 ; 00F361 1 A9 18 DISASS: lda #$18 ; disassemble 25 lines 00F363 1 85 0E sta COUNT1 00F365 1 D8 cld 00F366 1 A9 0C lda #$0C ; start with a formfeed 00F368 1 20 49 F2 jsr CHATS 00F36B 1 A9 0D MAIN1: lda #$0D ; carriage return/linefeed for each line 00F36D 1 20 49 F2 jsr CHATS 00F370 1 A9 0A lda #$0A 00F372 1 20 49 F2 jsr CHATS 00F375 1 A5 01 lda MOD+1 ; display current address 00F377 1 20 BB F3 jsr SPBYTE 00F37A 1 A5 00 lda MOD 00F37C 1 20 C2 F3 jsr BYTOUT 00F37F 1 A0 00 ldy #$00 00F381 1 A2 01 ldx #$01 ; X will be the byte count of the opcode 00F383 1 B9 00 00 lda MOD,y ; fetch opcode, find it’s no. of bytes 00F386 1 C9 20 cmp #$20 ; ‘jsr' is an anomaly and is done first 00F388 1 F0 17 beq CBYTE 00F38A 1 29 9F and #$9F 00F38C 1 F0 15 beq ABYTE ; binary 0XX00000 is 1 byte 00F38E 1 29 1D and #$1D 00F390 1 C9 19 cmp #$19 00F392 1 F0 0D beq CBYTE ; binary XXX110X1 is 3 bytes 00F394 1 29 0D and #$0D 00F396 1 C9 08 cmp #$08 00F398 1 F0 09 beq ABYTE ; binary XXXXX0X0 (now) is 1 byte 00F39A 1 29 0C and #$0C 00F39C 1 C9 0C cmp #$0C 00F39E 1 F0 01 beq CBYTE ; binary XXXX11XX is 3 bytes 00F3A0 1 CA dex ; all others are 2 bytes 00F3A1 1 E8 CBYTE: inx 00F3A2 1 E8 inx 00F3A3 1 A0 00 ABYTE: ldy #$00 00F3A5 1 B9 00 00 lda MOD,y 00F3A8 1 20 BB F3 jsr SPBYTE 00F3AB 1 E6 00 inc MOD ; increment the byte pointer 00F3AD 1 D0 02 bne NOINC4 00F3AF 1 E6 01 inc MOD+1 00F3B1 1 CA NOINC4: dex ; print all bytes required 00F3B2 1 D0 EF bne ABYTE 00F3B4 1 C6 0E dec COUNT1 00F3B6 1 10 B3 bpl MAIN1 ; finished the 25 lines ? 00F3B8 1 4C 04 FF GETOUT: jmp RESTART 00F3BB 1 48 SPBYTE: pha ; print a space and then the byte 00F3BC 1 A9 20 lda #$20 00F3BE 1 20 49 F2 jsr CHATS 00F3C1 1 68 pla 00F3C2 1 48 BYTOUT: pha ; print a byte 00F3C3 1 4A lsr A 00F3C4 1 4A lsr A 00F3C5 1 4A lsr A 00F3C6 1 4A lsr A 00F3C7 1 20 CB F3 jsr DIGOUT 00F3CA 1 68 pla 00F3CB 1 29 0F DIGOUT: and #$0F ; print the bottom hex digit in A 00F3CD 1 09 30 ora #$30 00F3CF 1 C9 3A cmp #$3A 00F3D1 1 90 02 bcc PUT 00F3D3 1 69 06 adc #$06 00F3D5 1 4C 49 F2 PUT: jmp CHATS 00F3D8 1 ; 00F3D8 1 ; *** NIM *** 00F3D8 1 ; 00F3D8 1 COUNT2 := $1F 00F3D8 1 NSTACK := $20 00F3D8 1 POSS := $24 00F3D8 1 ANAL := $28 00F3D8 1 ; 00F3D8 1 20 71 F4 HUMMOV: jsr DSPGAP ; display stacks 00F3DB 1 B5 10 SHFTPT: lda D,x ; set decimal point on 00F3DD 1 09 80 ora #$80 00F3DF 1 95 11 sta D+1,x 00F3E1 1 20 0C FE CHEAT: jsr DISPLAY ; wait for input 00F3E4 1 90 10 bcc MINUS 00F3E6 1 B5 11 lda D+1,x ; remove current decimal point 00F3E8 1 29 7F and #$7F 00F3EA 1 95 11 sta D+1,x 00F3EC 1 E8 inx ; move forward 00F3ED 1 E8 inx 00F3EE 1 E0 07 cpx #$07 ; end of stacks ? 00F3F0 1 90 E9 bcc SHFTPT 00F3F2 1 A2 00 ldx #$00 00F3F4 1 F0 E5 beq SHFTPT 00F3F6 1 A8 MINUS: tay 00F3F7 1 F0 E8 beq CHEAT ; prevent zero from being used 00F3F9 1 8A txa 00F3FA 1 4A lsr A ; address of required stack 00F3FB 1 AA tax 00F3FC 1 38 sec 00F3FD 1 B5 20 lda NSTACK,x ; do the players move 00F3FF 1 E5 0D sbc KEY 00F401 1 95 20 sta NSTACK,x 00F403 1 20 71 F4 COMMOV: jsr DSPGAP ; show stacks 00F406 1 84 0E sty REPEAT 00F408 1 A2 00 ldx #$00 00F40A 1 20 0C FE WAIT1: jsr DISPLAY ; thinking time 00F40D 1 CA dex 00F40E 1 D0 FA bne WAIT1 00F410 1 CA dex 00F411 1 86 0E stx REPEAT ; clear repeat status 00F413 1 A0 03 ldy #$03 00F415 1 A2 03 NEXT2: ldx #$03 ; transfer STACK to POSS 00F417 1 B5 20 BLOCK: lda NSTACK,x ; POSS repreensts the possible computer 00F419 1 95 24 sta POSS,x ; moves 00F41B 1 CA dex 00F41C 1 10 F9 bpl BLOCK 00F41E 1 A2 03 ONEOFF: ldx #$03 ; transfer POSS to ANAL 00F420 1 B5 24 BRICK: lda POSS,x ; ANAL represents the move being 00F422 1 95 28 sta ANAL,x ; analysed 00F424 1 CA dex 00F425 1 10 F9 bpl BRICK 00F427 1 A2 03 ldx #$03 00F429 1 B9 24 00 lda POSS,y 00F42C 1 38 sec 00F42D 1 E9 01 sbc #$01 00F42F 1 99 24 00 sta POSS,y ; POSS contains possible move 00F432 1 99 28 00 sta ANAL,y ; ANAL contains possible move 00F435 1 B0 12 bcs CHECK 00F437 1 88 dey 00F438 1 10 DB bpl NEXT2 ; try all stacks 00F43A 1 B5 20 TRY1: lda NSTACK,x ; check if stack is empty 00F43C 1 F0 05 beq EMPTY 00F43E 1 D6 20 dec NSTACK,x ; make desperate move 00F440 1 4C D8 F3 jmp HUMMOV 00F443 1 CA EMPTY: dex 00F444 1 10 F4 bpl TRY1 00F446 1 4C 04 FF jmp RESTART ; lost 00F449 1 A9 04 CHECK: lda #$04 00F44B 1 85 1F sta COUNT2 00F44D 1 A9 00 CONT: lda #$00 ; evaluate move 00F44F 1 46 28 lsr ANAL 00F451 1 2A rol A 00F452 1 46 29 lsr ANAL+1 00F454 1 69 00 adc #$00 00F456 1 46 2A lsr ANAL+2 00F458 1 69 00 adc #$00 00F45A 1 46 2B lsr ANAL+3 00F45C 1 69 00 adc #$00 00F45E 1 4A lsr A 00F45F 1 B0 BD bcs ONEOFF ; not a good move 00F461 1 C6 1F dec COUNT2 00F463 1 D0 E8 bne CONT ; keep checking the move 00F465 1 A2 03 ldx #$03 ; good move, transfer to actual stacks 00F467 1 B5 24 BAT: lda POSS,x 00F469 1 95 20 sta NSTACK,x 00F46B 1 CA dex 00F46C 1 10 F9 bpl BAT 00F46E 1 4C D8 F3 jmp HUMMOV ; opponent 00F471 1 A9 00 DSPGAP: lda #$00 00F473 1 A2 07 ldx #$07 00F475 1 95 10 CLEAR1: sta D,x ; clear the display first 00F477 1 CA dex 00F478 1 10 FB bpl CLEAR1 00F47A 1 D8 cld ; clear decimal mode 00F47B 1 A2 04 ldx #$04 00F47D 1 A0 07 ldy #$07 00F47F 1 B5 1F AROUND: lda NSTACK-1,x 00F481 1 20 7A FE jsr HEXTD 00F484 1 88 dey 00F485 1 88 dey 00F486 1 CA dex 00F487 1 D0 F6 bne AROUND 00F489 1 A0 1F ldy #$1F 00F48B 1 60 rts 00F48C 1 ; 00F48C 1 ; *** DUCK SHOOT *** 00F48C 1 ; 00F48C 1 TIME := $0E 00F48C 1 DEDDCK := $1C 00F48C 1 DUCK := $61 00F48C 1 ; 00F48C 1 A9 1F BEGIN: lda #$1F ; single scan display routine 00F48E 1 85 0E sta TIME 00F490 1 A9 00 lda #$00 ; clear the display 00F492 1 A2 07 ldx #$07 00F494 1 86 20 stx $20 00F496 1 95 10 CLEAR2: sta $10,x 00F498 1 CA dex 00F499 1 10 FB bpl CLEAR2 00F49B 1 A9 00 REMOVE: lda #$00 ; take the old duck off 00F49D 1 A6 20 ldx $20 00F49F 1 95 10 sta $10,x 00F4A1 1 A9 61 INSERT: lda #DUCK ; put new duck on 00F4A3 1 CA dex ; in new position 00F4A4 1 10 02 bpl OLDX ; but not over the end of the display 00F4A6 1 A2 07 ldx #$07 00F4A8 1 95 10 OLDX: sta $10,X 00F4AA 1 86 20 stx $20 00F4AC 1 A2 0E ldx #TIME ; display interval is set by the byte loaded into X 00F4AE 1 20 0C FE WAIT2: jsr DISPLAY 00F4B1 1 C5 20 cmp $20 ; hit ? 00F4B3 1 F0 05 beq HIT 00F4B5 1 CA dex 00F4B6 1 D0 F6 bne WAIT2 00F4B8 1 F0 E1 beq REMOVE ; finished wait time 00F4BA 1 A9 1C HIT: lda #DEDDCK ; put in a dead duck 00F4BC 1 A6 20 ldx $20 00F4BE 1 95 10 sta $10,x 00F4C0 1 A9 FF lda #$FF 00F4C2 1 85 0E sta TIME 00F4C4 1 20 0C FE jsr DISPLAY ; test for continuation 00F4C7 1 90 C3 bcc BEGIN 00F4C9 1 4C 04 FF jmp RESTART ; or back to the Monitor 00F4CC 1 ; 00F4CC 1 ; *** BULLS and COWS (MASTERMIND) *** (from the Liverpool Software Gazette) 00F4CC 1 ; 00F4CC 1 MESSPO := $0020 ; pointer to messages 00F4CC 1 RAN := $0022 ; random numbers here 00F4CC 1 MYNO := $0025 ; hidden Acorn's number 00F4CC 1 YGU := $0027 ; humans guess 00F4CC 1 NUMA := $0029 ; number to be matched 00F4CC 1 NUMB := $002D ; number to be matched with 00F4CC 1 BULLS := $0031 00F4CC 1 COWS := $0032 00F4CC 1 LIST := $0033 ; used to calculate cows 00F4CC 1 MYGU := $003B ; my new guess 00F4CC 1 STRT := $003D ; start of guesses 00F4CC 1 ANSWER := $003F ; answer from piran 00F4CC 1 GSEND := $0040 ; end of guess stack 00F4CC 1 GUNO := $0041 ; present guess on stack 00F4CC 1 TEMPA := $0042 ; two temporary locatiosn for ROR 00F4CC 1 TEMPB := $0043 00F4CC 1 ; 00F4CC 1 A9 00 MATCH: lda #$00 00F4CE 1 A2 09 ldx #$09 ; clear bulls, cows 00F4D0 1 95 31 CLEAR: sta BULLS,X ; and list 00F4D2 1 CA dex 00F4D3 1 10 FB bpl CLEAR 00F4D5 1 A0 03 ldy #$03 00F4D7 1 B9 29 00 CMPARE: lda NUMA,Y ; digit from NUMA 00F4DA 1 D9 2D 00 cmp NUMB,Y ; is it a bull ? 00F4DD 1 D0 04 bne NOBULL ; no 00F4DF 1 E6 31 inc BULLS ; count a bull 00F4E1 1 10 11 bpl NOCOWS ; it can't be a cow 00F4E3 1 AA NOBULL: tax ; is it a cow then ? 00F4E4 1 F6 33 inc LIST,X ; increment via digit 00F4E6 1 F0 02 beq COWCNT ; it is a cow 00F4E8 1 10 02 bpl NOCOW ; it is not a cow 00F4EA 1 E6 32 COWCNT: inc COWS ; count a cow 00F4EC 1 B6 2D NOCOW: ldx NUMB,Y ; try other way 00F4EE 1 D6 33 dec LIST,X ; decrement via digit 00F4F0 1 30 02 bmi NOCOWS ; it is not a cow 00F4F2 1 E6 32 inc COWS ; count a cow 00F4F4 1 88 NOCOWS: dey ; next digit 00F4F5 1 10 E0 bpl CMPARE ; round again 00F4F7 1 A5 31 lda BULLS ; now assemble answer 00F4F9 1 0A asl A 00F4FA 1 0A asl A 00F4FB 1 0A asl A 00F4FC 1 0A asl A 00F4FD 1 05 32 ora COWS 00F4FF 1 60 rts ; and return 00F500 1 B9 00 00 UNPACK: lda $0000,Y ; put number 00F503 1 85 42 sta TEMPA ; to be unpacked 00F505 1 B9 01 00 lda $0001,Y ; in TEMPA 00F508 1 A0 04 ldy #$04 ; (4 digits to unpack) 00F50A 1 85 43 UNLOOP: sta TEMPB ; and TEMPB 00F50C 1 29 07 and #$07 ; extract digit 00F50E 1 95 00 sta $00,X ; save unpacked form 00F510 1 A5 43 lda TEMPB ; reload lower byte 00F512 1 66 42 ror TEMPA ; 2-byte 3-bit rotate 00F514 1 6A ror A 00F515 1 66 42 ror TEMPA 00F517 1 6A ror A 00F518 1 66 42 ror TEMPA 00F51A 1 6A ror A 00F51B 1 E8 inx ; next digit 00F51C 1 88 dey ; Y is a counter 00F51D 1 D0 EB bne UNLOOP ; round again 00F51F 1 60 rts ; and return 00F520 1 A9 1F DISRAN: lda #$1F ; set single scan 00F522 1 85 0E sta REPEAT 00F524 1 20 0C FE DESCAN: jsr DISPLAY ; monitor scan call 00F527 1 49 1F eor #$1F ; key ? 00F529 1 D0 11 bne KEYFO ; yes 00F52B 1 A5 24 lda RAN+2 ; generate random 00F52D 1 29 42 and #TEMPA ; numbers, next bit in 00F52F 1 69 3E adc #STRT+1 ; bit six of A 00F531 1 0A asl A ; and put in carry 00F532 1 0A asl A 00F533 1 26 22 rol RAN ; now rotate the bits 00F535 1 26 23 rol RAN+1 ; round the 3 bytes 00F537 1 26 24 rol RAN+2 00F539 1 4C 24 F5 jmp DESCAN ; and round again 00F53C 1 90 01 KEYFO: bcc NORET ; cont or key ? 00F53E 1 60 rts ; yes so return 00F53F 1 A5 3F NORET: lda ANSWER ; digit key so 00F541 1 0A asl A ; assemble new answer 00F542 1 0A asl A ; last digit up 4 bits 00F543 1 0A asl A 00F544 1 0A asl A 00F545 1 05 0D ora KEY ; put in new digit 00F547 1 85 3F sta ANSWER ; store in ANSWER 00F549 1 20 60 FE jsr RDHEXTD ; A to display 00F54C 1 4C 24 F5 jmp DESCAN ; and round again 00F54F 1 A9 FF MSSAGE: lda #$FF ; message to display 00F551 1 85 0E sta REPEAT ; set scan mode for QOCTFE 00F553 1 86 20 stx MESSPO ; setup pointer 00F555 1 A0 07 ldy #$07 ; 8 digits to fetch 00F557 1 B1 20 MLOOP: lda (MESSPO),Y ; post index fetch 00F559 1 99 10 00 sta D,Y ; put in display buffer 00F55C 1 88 dey ; next digit 00F55D 1 10 F8 bpl MLOOP ; round again 00F55F 1 60 SUBRET: rts ; or return 00F560 1 20 7A F5 QOCTFE: jsr QOCTTD ; display old 00F563 1 20 0C FE jsr DISPLAY ; MONITOR scan call 00F566 1 B0 F7 bcs SUBRET ; control key return 00F568 1 A0 03 ldy #$03 ; 3 bits to shift 00F56A 1 29 07 and #$07 ; keys range 0 to 7 00F56C 1 16 01 SHIFT: asl $01,X ; this is the 3 00F56E 1 36 00 rol $00,X ; bit shift 00F570 1 88 dey 00F571 1 D0 F9 bne SHIFT 00F573 1 15 01 ora $01,X ; put new key in 00F575 1 95 01 sta $01,X ; store new entry 00F577 1 4C 60 F5 jmp QOCTFE ; and round again 00F57A 1 A0 04 QOCTTD: ldy #$04 ; 4 octal 00F57C 1 B5 00 lda $00,X ; digits to display 00F57E 1 85 42 sta TEMPA ; use TEMPA and TEMPB 00F580 1 B5 01 lda $01,X 00F582 1 85 43 DISLOP: sta TEMPB ; save lower byte 00F584 1 29 07 and #$07 ; mask digit 00F586 1 20 7A FE jsr HEXTD ; digit to display buffer 00F589 1 A5 43 lda TEMPB ; reload lower byte 00F58B 1 66 42 ror TEMPA ; now 3-bit 2-byte 00F58D 1 6A ror A ; rotate 00F58E 1 66 42 ror TEMPA 00F590 1 6A ror A 00F591 1 66 42 ror TEMPA 00F593 1 6A ror A 00F594 1 88 dey ; next digit 00F595 1 D0 EB bne DISLOP ; and round again 00F597 1 60 rts ; or return 00F598 1 A9 FF MBEGIN: lda #$FF 00F59A 1 85 22 sta RAN 00F59C 1 A9 44 MstaRT: lda #$44 ; reset stack end 00F59E 1 85 40 sta GSEND 00F5A0 1 A9 03 lda #$03 ; set mess pointer 00F5A2 1 85 21 sta MESSPO+1 00F5A4 1 A2 A7 ldx #$A7 ; message ready 00F5A6 1 20 4F F5 jsr MSSAGE 00F5A9 1 20 20 F5 jsr DISRAN ; display ready 00F5AC 1 A5 23 lda RAN+1 ; put random number 00F5AE 1 85 26 sta MYNO+1 ; as my number 00F5B0 1 A5 22 lda RAN 00F5B2 1 29 0F and #$0F 00F5B4 1 85 25 sta MYNO 00F5B6 1 A2 C2 YOUGO: ldx #$C2 ; clear display 00F5B8 1 20 4F F5 jsr MSSAGE 00F5BB 1 A9 FF lda #$FF ; set scan mode 00F5BD 1 85 0E sta REPEAT 00F5BF 1 A2 27 ldx #YGU ; fetch your guess 00F5C1 1 20 60 F5 jsr QOCTFE 00F5C4 1 A2 29 ldx #NUMA ; num number to NUMA 00F5C6 1 A0 25 ldy #MYNO 00F5C8 1 20 00 F5 jsr UNPACK 00F5CB 1 A2 2D ldx #NUMB ; your number to NUMB 00F5CD 1 A0 27 ldy #YGU 00F5CF 1 20 00 F5 jsr UNPACK 00F5D2 1 20 CC F4 jsr MATCH ; and compare them 00F5D5 1 C9 40 cmp #GSEND ; four bulls !!? 00F5D7 1 D0 18 bne NOWIN ; phew !! 00F5D9 1 A2 B4 ldx #$B4 ; drat you 00F5DB 1 20 4F F5 ENDOUT: jsr MSSAGE ; end of game 00F5DE 1 20 20 F5 jsr DISRAN ; display message 00F5E1 1 A2 C2 ldx #$C2 ; clear display 00F5E3 1 20 4F F5 jsr MSSAGE 00F5E6 1 A2 25 ldx #MYNO 00F5E8 1 20 7A F5 jsr QOCTTD 00F5EB 1 20 20 F5 jsr DISRAN 00F5EE 1 4C DF FE jmp START ; ready to play again 00F5F1 1 20 60 FE NOWIN: jsr RDHEXTD ; MONITOR A to display 00F5F4 1 20 20 F5 jsr DISRAN ; display bulls/cows 00F5F7 1 A5 22 lda RAN ; random number is my guess 00F5F9 1 29 0F and #$0F ; and rememeber where we are 00F5FB 1 85 3B sta MYGU ; start 00F5FD 1 85 3D sta STRT 00F5FF 1 A5 23 lda RAN+1 00F601 1 85 3C sta MYGU+1 00F603 1 85 3E sta STRT+1 00F605 1 A0 3B NEWGU: ldy #MYGU 00F607 1 A2 2D ldx #NUMB ; unpacked to NUMB 00F609 1 20 00 F5 jsr UNPACK 00F60C 1 A0 44 ldy #$44 ; reset guess pointer 00F60E 1 C4 40 NEWINF: cpy GSEND ; end of stack ? 00F610 1 84 41 sty GUNO ; store guess pointer 00F612 1 F0 30 beq FOUND ; yes stack finished 00F614 1 A2 29 ldx #NUMA ; stacked guess 00F616 1 20 00 F5 jsr UNPACK ; unpacked to NUMA 00F619 1 20 CC F4 jsr MATCH ; compare new answer 00F61C 1 A4 41 ldy GUNO ; with old answers 00F61E 1 D9 02 00 cmp $0002,Y 00F621 1 D0 05 bne NOGOOD ; does not fit 00F623 1 C8 iny ; next stack entry 00F624 1 C8 iny 00F625 1 C8 iny 00F626 1 D0 E6 bne NEWINF ; try this entry 00F628 1 E6 3C NOGOOD: inc MYGU+1 ; increment 00F62A 1 D0 08 bne NOTUP ; my guess as the last 00F62C 1 E6 3B inc MYGU ; one was no good 00F62E 1 A5 3B lda MYGU 00F630 1 29 0F and #$0F 00F632 1 85 3B sta MYGU 00F634 1 A5 3C NOTUP: lda MYGU+1 ; if we count 00F636 1 C5 3E cmp STRT+1 ; round to the start 00F638 1 D0 CB bne NEWGU ; then somebody is 00F63A 1 A5 3B lda MYGU ; cheating otherwise 00F63C 1 C5 3D cmp STRT ; try this new guess 00F63E 1 D0 C5 bne NEWGU 00F640 1 A2 BC ldx #$BC ; you rotter 00F642 1 D0 97 bne ENDOUT ; end of game 00F644 1 A5 3B FOUND: lda MYGU ; put this good 00F646 1 99 00 00 sta $0000,Y ; on the stack 00F649 1 A5 3C lda MYGU+1 00F64B 1 99 01 00 sta $0001,Y 00F64E 1 A2 C4 ldx #$C4 ;"......__“ to display 00F650 1 20 4F F5 jsr MSSAGE 00F653 1 A2 3B ldx #MYGU ; my guess to display 00F655 1 20 7A F5 jsr QOCTTD 00F658 1 20 20 F5 jsr DISRAN ; use DISRAN to get answer 00F65B 1 A5 3F lda ANSWER 00F65D 1 C9 40 cmp #GSEND ; 4 bulls ? I win 00F65F 1 D0 05 bne NOIWIN ; no not yet I don't 00F661 1 A2 AD ldx #$AD ; message and end game 00F663 1 4C DB F5 jmp ENDOUT 00F666 1 A4 41 NOIWIN: ldy GUNO ; put answer on stack 00F668 1 99 02 00 sta $0002,Y 00F66B 1 C8 iny ; update stack end 00F66C 1 C8 iny 00F66D 1 C8 iny 00F66E 1 84 40 sty GSEND 00F670 1 4C B6 F5 jmp YOUGO ; and round again 00F673 1 ; 00F673 1 00 50 79 77 READY: .byte $00,$50,$79,$77,$5E,$6E 00F677 1 5E 6E 00F679 1 00 00 06 00 IWIN: .byte $00,$00,$06,$00,$1C,$04,$54 00F67D 1 1C 04 54 00F680 1 00 6E 3F 3E YOUWIN: .byte $00,$6E,$3F,$3E,$00,$1C,$04,$54 00F684 1 00 1C 04 54 00F688 1 00 39 76 79 MCHEAT: .byte $00,$39,$76,$79,$77,$78 00F68C 1 77 78 00F68E 1 00 00 BLANK: .byte $00,$00 00F690 1 00 00 00 00 PROMPT: .byte $00,$00,$00,$00,$00,$00,$08,$08 00F694 1 00 00 08 08 00F698 1 ; 00F698 1 ; *** COUNTER KEYBOARD *** 00F698 1 ; 00F698 1 COUNT := $19 00F698 1 ; 00F698 1 20 0C FE DISP: jsr DISPLAY ; look for key 00F69B 1 90 0A bcc CHANGE ; check if control key carry set if so 00F69D 1 C9 17 cmp #$17 00F69F 1 F0 1F beq DOWN1 00F6A1 1 C9 16 cmp #$16 00F6A3 1 F0 11 beq UP1 00F6A5 1 D0 F1 bne DISP 00F6A7 1 C9 00 CHANGE: cmp #$00 00F6A9 1 85 19 sta COUNT 00F6AB 1 F0 EB MORE: beq DISP ; increment No. of times of TEY 00F6AD 1 20 DB F6 jsr INCR 00F6B0 1 C6 19 dec COUNT 00F6B2 1 10 F7 bpl MORE 00F6B4 1 30 E2 bmi DISP 00F6B6 1 20 DB F6 UP1: jsr INCR ; rapid increment 00F6B9 1 20 CA F6 jsr ZOOM 00F6BC 1 D0 DA bne DISP 00F6BE 1 F0 F6 beq UP1 00F6C0 1 20 E4 F6 DOWN1: jsr DECR ; rapid decrement 00F6C3 1 20 CA F6 jsr ZOOM 00F6C6 1 D0 D0 bne DISP 00F6C8 1 F0 F6 beq DOWN1 00F6CA 1 A9 1F ZOOM: lda #$1F 00F6CC 1 85 0E sta $0E ; set for one scan only 00F6CE 1 20 0C FE jsr DISPLAY 00F6D1 1 90 03 bcc STOP ; check if key depressed claer if one is 00F6D3 1 A9 00 lda #$00 00F6D5 1 60 rts 00F6D6 1 A9 FF STOP: lda #$FF ; reset so that jsr DISPLAY waits for input 00F6D8 1 85 0E sta $0E 00F6DA 1 60 rts 00F6DB 1 ; 00F6DB 1 ; *** COUNTER KEYBOARD SUBROUTINE *** 00F6DB 1 ; 00F6DB 1 CNTL := $1A 00F6DB 1 CNTH := $1B 00F6DB 1 ; 00F6DB 1 F6 1A INCR: inc CNTL,x 00F6DD 1 D0 0D bne UPDATE 00F6DF 1 E6 1B inc CNTH 00F6E1 1 38 sec 00F6E2 1 B0 08 bcs UPDATE 00F6E4 1 A5 1A DECR: lda CNTL 00F6E6 1 D0 02 bne NOT 00F6E8 1 C6 1B dec CNTH 00F6EA 1 C6 1A NOT: dec CNTL 00F6EC 1 A2 1A UPDATE: ldx #$1A 00F6EE 1 20 64 FE jsr QHEXTD1 00F6F1 1 60 rts 00F6F2 1 ; 00F6F2 1 ; *** METRONOME *** 00F6F2 1 ; 00F6F2 1 PERIOD := $20 00F6F2 1 CLRPA6 := $0E06 ; clear bit 6 of PIA 00F6F2 1 SETPA6 := $0E16 ; set bit 6 of PIA 00F6F2 1 ; 00F6F2 1 A9 1F METRO: lda #$1F 00F6F4 1 85 0E sta REPEAT ; set display to single scan 00F6F6 1 A9 40 PULSE: lda #$40 00F6F8 1 8D 22 0E sta ADDR ; define PA6 as output 00F6FB 1 8D 16 0E sta SETPA6 ; use the INS8154 set bit mode 00F6FE 1 20 CD FE jsr WAIT ; use the 300 baud wait 00F701 1 8D 06 0E sta CLRPA6 ; use the INS8154 clear bit mode 00F704 1 A6 20 ldx PERIOD 00F706 1 20 0C FE DEL2: jsr DISPLAY ; look at keyboard 00F709 1 C9 16 cmp #$16 ; up key ? 00F70B 1 D0 04 bne DOWN2 ; no 00F70D 1 E6 20 inc PERIOD ; decrease PERIOD 00F70F 1 B0 E5 bcs PULSE ; carry was set by the compare: always 00F711 1 C9 17 DOWN2: cmp #$17 ; down key ? 00F713 1 D0 04 bne DELI ; no 00F715 1 C6 20 dec PERIOD ; decrease PERIOD 00F717 1 B0 DD bcs PULSE ; carry was set by the compare: always 00F719 1 A0 0C DELI: ldy #$0C ; cycle time of u1/2 seconds 00F71B 1 20 CD FE DELJ: jsr WAIT 00F71E 1 88 dey 00F71F 1 10 FA bpl DELJ 00F721 1 CA dex 00F722 1 D0 E2 bne DEL2 00F724 1 F0 D0 beq PULSE ; end of this period so pulse 00F726 1 ; 00F726 1 ; *** EIGHT QUEENS PROBLEM *** 00F726 1 ; 00F726 1 ROW := $20 00F726 1 LEFT := $29 00F726 1 RIGHT := $32 00F726 1 ; 00F726 1 F8 QUEENS: sed 00F727 1 A2 20 ldx #$20 00F729 1 84 19 sty COUNT ; clear count 00F72B 1 84 20 sty ROW ; clear row occupied 00F72D 1 84 29 sty LEFT ; clear left diagonal attacks 00F72F 1 84 32 sty RIGHT ; clear right diagonal attacks 00F731 1 20 3C F7 jsr TRY2 ; find the No. of ways 00F734 1 A5 19 lda COUNT 00F736 1 20 60 FE jsr RDHEXTD ; display answer 00F739 1 4C 04 FF jmp RESTART 00F73C 1 B5 00 TRY2: lda $00,x ; finished yet ? 00F73E 1 C9 FF cmp #$FF 00F740 1 D0 07 bne CONTIN 00F742 1 A5 19 lda COUNT ; finished, so increment count 00F744 1 69 00 adc #$00 00F746 1 85 19 sta COUNT 00F748 1 60 FINISH: rts 00F749 1 15 09 CONTIN: ora $09,x ; current left 00F74B 1 15 12 ora $12,x ; current right 00F74D 1 A8 LOOP5: tay 00F74E 1 49 FF eor #$FF 00F750 1 F0 F6 beq FINISH ; no chance 00F752 1 95 1B sta $1B,x ; current possible place 00F754 1 C8 iny 00F755 1 98 tya 00F756 1 35 1B and $1B,x 00F758 1 A8 tay 00F759 1 15 00 ora $00,x 00F75B 1 95 01 sta $01,x ; new row 00F75D 1 98 tya 00F75E 1 15 09 ora $09,x 00F760 1 0A asl A 00F761 1 95 0A sta $0A,x ; new left attack 00F763 1 98 tya 00F764 1 15 12 ora $12,x 00F766 1 4A lsr A 00F767 1 95 13 sta $13,x ; new right attack 00F769 1 E8 inx 00F76A 1 20 3C F7 jsr TRY2 00F76D 1 CA dex 00F76E 1 B5 01 lda $01,x 00F770 1 49 FF eor #$FF 00F772 1 35 1B and $1B,x 00F774 1 49 FF eor #$FF 00F776 1 4C 4D F7 jmp LOOP5 00F779 1 ; 00F779 1 ; *** 'Acorn 1' *** (mikes on Stardot) 00F779 1 ; 00F779 1 A2 07 ACORN1: ldx #$07 00F77B 1 BD 89 F7 LOOP6: lda MESAGE,X 00F77E 1 95 10 sta D,X 00F780 1 CA dex 00F781 1 10 F8 bpl LOOP6 00F783 1 20 0C FE jsr DISPLAY 00F786 1 4C FB FE jmp INIT 00F789 1 ; 00F789 1 00 77 58 5C MESAGE: .byte $00,$77,$58,$5c,$50,$54,$00,$30 00F78D 1 50 54 00 30 00F791 1 ; 00F791 1 ; Fill space with FF's 00F791 1 ; 00F791 1 .listbytes 4 00F791 1 FF FF FF FF .repeat $66E 00FDFF 1 .byte $FF 00FDFF 1 .endrep 00FDFF 1 FF .byte $FF 00FE00 1 .listbytes unlimited 00FE00 1 ; 00FE00 1 ; *** Acorn System 1 'Monitor' *** 00FE00 1 ; 00FE00 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