;
; SOFTY 2 Firmware
;
; Extracted from EPROMs on original SOFTY 2's owned by Tim Gilberts and Peter Golding
;
; Formatted for the SB-Assembler (https://www.sbprojects.net/sbasm/)
;
; Chris Oddy	November 2023
;
	.CR	scmp			; 8060
	.LF	softy2.list		; listing file
	.TF	softy2.bin		; object file
;
; Registers
;
;	Pointer Register 1 (P1)	Cursor Pointer
;	Pointer Register 2 (P2)	Register Pointer, set to $0B00 to point at IC21 RAM
;					between $0B00 and $0BFF and with negative offsets
;					at IC21 I/O between $0620 and $06A4
;	Pointer Register 3 (P3)	Subroutine Pointer
;
; Processor Flag Outputs
;
; 	Flag 0			cursor write
;	Flag 1			EPROM VDD pulse enable
;	Flag 2			HALT Latch
;
; SENSE-A Keypress Input
; SENSE-B Serial Input
;
; 8154 I/O ($0A80 to $0A7F)
;
; (offset from P2: $0B00)
PORTA 	.EQ	-$60		; Port A Data Register (address $0AA0)
PORTB 	.EQ	-$5F		; Port B Data Register (address $0AA1)
ODRA 		.EQ	-$5E		; Port A Output Definition Register (address $0AA2)
ODRB 		.EQ	-$5D		; Port B Output Definition Register (address $0AA3)
;
; Port A:				PA0 to PA2 screen page select (outputs)
;					PA3 to PA7 keyboard column scan (outputs), PA3 not used, avaliable at JB
; Port B:				PB0 to PB7 keyboard row scan (inputs), PB7 not used, avaliable at JB
;
; 8154 RAM ($0B00 to $0B7F)
;					; 0B00 set to $3E at start ?
;					; 0B01
;
; Status Line (top line of display)
; (offsets from P2 $0B00)
curpH		.EQ	$70		; $0770 Cursor Pointer high byte (P1H)
curpL		.EQ	$71		; $0771 Cursor Pointer low byte (P1L)
acurpH	.EQ 	$72		; $0772 Alternate Cursor high byte
acurpL	.EQ	$73		; $0773 Alternate Cursor low byte
subpH		.EQ	$74		; $0774 Subroutine Pointer high byte (P3H)
subpL		.EQ	$75		; $0775 Subroutine Pointer low byte (P3L)
accum		.EQ	$76		; $0776 Accumulator (A)
extreg	.EQ	$77		; $0777 Extension Register (E)
streg		.EQ	$78		; $0778 Status Register (SR)
ppword	.EQ	$79		; $0779 Parallel Parity Word
matchb	.EQ	$7A		; $077A Matchbyte (highlighted)
keywrd	.EQ	$7B		; $077B Keyword
curspd	.EQ	$7C		; $077C Cursor Speed Counter
endarc	.EQ	$7D		; $077D End Around Carry (flags 1st/2nd digit of entered byte)
hexdif	.EQ	$7E		; $077E Hexadecimal Difference between cursors
prompt	.EQ	$7F		; $077F Prompt, Mode etc.
;
		.org	$0000
;
		NOP
					; Entry point on Reset
		LDI	$0A
		XPAH	P2
		LDI	$70
		XPAL	P2		; P2 = $0A70
L0007:	ST	@1(P2)	; (A = 0), clear $0A70 to $0AFF ??
		XPAL	P2		; test P2L
		JZ	DONE		; exit loop if P2L zero
		XPAL	P2		; restore P2L and A
		JMP	L0007		; and go round again
DONE:		LDI	$18		; point cursor pointers at page $18 (P2 = $0B00 from here on)
		ST	curpH(P2)
		ST	acurpH(P2)
		LDI	$00
		ST	ODRB(P2)	; set Port B to all inputs
		LDI	$FF
		ST	ODRA(P2)	; set Port A to all outputs
		LDI	$3E
		ST	0(P2)		; $0B00=$3E
L0021:	LDI	$00
		CAS			; clear all Flags
		XPAL	P1
		LDI	$18
		XPAH	P1		; P1=$1800 (RAM Buffer)
L0028:	LDI	$10
		XAE			; E=$10
		LD	0(P1)		; clear cursor
		ST	@1(P1)	; and increment pointer
		XPAH	P1
		XAE			; E=P1H, A=$10
		XRE
		JZ	L0038		; finished ?
		XAE			; restore P1H
		XPAH	P1
		JMP	L0028		; continue
;
					; routine to ??
L0038:	LD	curpH(P2)	; copy Cursor Pointer to P1
		XPAH	P1
		LD	curpL(P2)
		XPAL	P1
SCANKEYP3:	LDI	$07		; setup subroutine call
		XPAH	P3
		LDI	$00
		XPAL	P3		; P3=$0700
SCANKEY:	XPPC	P3		; call routine at $0701
		HALT			; and HALT awaiting a keypress
		LD	keywrd(P2)	; then retrieve Keyword
		RR			; rotate right 4-bits - swap nibble order
		RR
		RR
		RR
		XAE			; E = Keyword (nibbles reversed)
		LDI	$01
		ANE			; AND with E
		JNZ	FUNCTION	; jump if bit 1 set (Function ?)
		ILD	prompt(P2)	; increment Prompt, result in A
		ANI	$01		; AND with $01
		JZ	DIGIT2	; jump if bit 1 is clear (2nd digit of byte
		XAE			; retrieve E (Keyword with nibbles reversed)
		ST	0(P1)		; and store at cursor pointer location (1st digit of byte)
		JMP	SCANKEY	; scan keyboard again
;
DIGIT2:	LD	streg(P2)	; load Status Line Status Register
		CAS			; and transfer to SR
		LD	0(P1)		; load value at Cursor Pointer location
		OR	keywrd(P2)	; OR with Keyword (2nd digit of byte)
		ST	@1(P1)	; put back and increment Cursor Pointer
		JMP	SCANKEY	; scan keyboard again
;
FUNCTION:	LDI	$00		; A=0
		ST	prompt(P2)	; clear Prompt (reset to 1st digit for next time)
		LDI	$41		; EXECUTE Command ?
		XRE
		JNZ	LEFT		; jump if not EXECUTE
					; EXECUTE - ?
		LD	@-1(P1)
		LD	subpH(P2)	; transfer Subroutine Pointer to P3
		XPAH	P3		; high byte
		LD	subpL(P2)
		XPAL	P3		; low byte
		LD	streg(P2)	; load Status Line Status Register
		CAS			; and transfer to SR
		LD	extreg(P2)	; load Status Line Extension Register
		XAE			; and transfer to E
		LD	accum(P2)	; load Status Line Accumulator
		XPPC	P1		; call P1 ??
		ST	accum(P2)	; update Status Line Accumulator
		XAE			; transfer E to A
		ST	extreg(P2)	; update Status Line Extension Register
		CSA			; transfer SR to A
		ST	streg(P2)	; update Status Line Status Register
		XPAL	P3		; update Status Line Subroutine Pointer
		ST	subpL(P2)	; low byte
		XPAH	P3
		ST	subpH(P2)	; high byte
L0090:	JMP	SCANKEYP3	; call keyboard scan routine (restoring P3)
;
L0092:	JMP	L0021
;
LEFT:		LDI	$71		; LEFT Command ?
		XRE
		JNZ	INSERT	; jump if not LEFT
					; LEFT ??
		LD	streg(P2)	; load Status Line Status Register
		CAS			; transfer to SR
		LD	0(P1)		; clear Cursor at Cursor Pointer
		ST	0(P1)
		LD	@-1(P1)
		JMP	L0090		; jump to call keyboard scan routine (restoring P3)
;
INSERT:	LDI	$91		; INSERT Command ?
		XRE
		JNZ	L00C9		; jump if not INSERT
					; INSERT - ??
		LDI	$DD
		XPAL	P3		; P3=$xxDD
		XPPC	P3		; return
L00AD:	LD	-2(P1)
		ST	@-1(P1)
		XPAH	P1
		XAE
		LD	curpH(P2)
		XRE
		JZ	L00BC
		LDE
		XPAH	P1
		JMP	L00AD
;
L00BC:	LDE
		XPAH	P1
		XPAL	P1
		XAE
		LD	curpL(P2)
		XRE
L00C3:	JZ	L0092
		LDE
		XPAL	P1
		JMP	L00AD
;
L00C9:	LDI	$A1		; DELETE Command ?
		XRE
		JNZ	L00F5		; jump if not DELETE
					; DELETE - ??
		LDI	$DD
		XPAL	P3		; P3=$xxDD
		XPPC	P3		; return
		LDI	$FF
		XAE			; E=$FF
L00D5:	LD	@-1(P1)	; get byte at cursor and decrement P1
		XAE			; put in E (A=$FF)
		ST	0(P1)		; put $FF at cursor location
		XAE
		XPAH	P1
		XAE			; E=P1H
		LD	curpH(P2)
		XRE
		JZ	L00E7
		XAE			; restore P1H
		XPAH	P1
		XAE
		JMP	L00D5
;
L00E7:	XAE
		XPAH	P1
		XPAL	P1
		XAE
		LD	curpL(P2)
		XRE
		JZ	L00C3
		XAE
		XPAL	P1
		XAE
		JMP	L00D5
;
L00F5:	LDI	$81		; $81 Command ? RIGHT ??
		XRE
		JNZ	MOVE		; jump if not $81
					; $81 ??
		CAS			; clear SR
		LD	0(P1)		; get byte at cursor
		ST	@1(P1)	; put back and decrement P1
		JMP	L0090
;
MOVE:		LDI	$11		; MOVE Command ?
		XRE
		JNZ	STORE		; jump if not MOVE
					; MOVE - moves a DEFINEd block through the RAM Buffer
		LDI	$EE
		ST	prompt(P2)	; Prompt=$EE
L010A:	XPPC	P3		; return
		HALT
		LD	keywrd(P2)	; retrieve Keyword
		XAE			; put in E
		LDI	$18		; FORWARD Command ?
		XRE
		JNZ	L0136		; jump if not FORWARD
		ILD	hexdif(P2)
		XAE
		LD	E(P1)
		ST	endarc(P2)
L011B:	LDI	$01
		CAS			; set Flag 0 (Cursor) (clear Carry)
		DLD	hexdif(P2)
		XAE
		LD	E(P1)
		XAE
		ADI	$01		; add 1
		XAE
		ST	E(P1)
		XAE
		JNZ	L011B
		CAS			; clear SR
		NOP
		LD	endarc(P2)
		ST	@1(P1)
		ILD	acurpL(P2)
		JMP	L010A
;
L0136:	LDI	$17		; BACK Command ?
		XRE
		JZ	L0141		; jump if not BACK
		LDI	$00
		ST	streg(P2)
		JMP	L0197
;
L0141:	LD	-1(P1)
		ST	endarc(P2)
		ILD	hexdif(P2)
		LDI	$00
		XAE
L014A:	LDI	$01
		CAS			; set Flag 0 (Cursor)
		LD	E(P1)
		XAE
		ADI	$FF
		XAE
		ST	E(P1)
		CCL
		XAE
		ADI	$02
		XAE
		LD	hexdif(P2)
		XRE
		JNZ	L014A
		CAS			; clear all Flags
		DLD	hexdif(P2)
		XAE
		LD	endarc(P2)
		ST	E(P1)
		DLD	acurpL(P2)
		LD	@-1(P1)
		JMP	L010A
;
STORE:	LDI	$21		; STORE Command ?
		XRE
		JNZ	REPLACE	; jump if not STORE
					; STORE - ??
		ST	streg(P2)
		XAE
		ILD	hexdif(P2)
L0177:	LD	E(P1)
		XAE
		CCL
		ADI	$01
		XAE
		ST	E(P2)
		LD	hexdif(P2)
		XRE
		JNZ	L0177
		XAE
		ST	$6F(P2)
		ILD	hexdif(P2)
		XAE
		LDI	$90
		ST	E(P2)
		ILD	hexdif(P2)
		XAE
		LDI	$00
		CAS			; clear all Flags
		CAD	hexdif(P2)
L0197:	ST	E(P2)
		JMP	L020B
;
REPLACE:	LDI	$31		; REPLACE Command ?
		XRE
		JNZ	L01B6		; jump if not REPLACE
					; REPLACE - ??
		XAE
L01A1:	LD	$6F(P2)
		XRE
		JNZ	L01AB
		LDI	$3D
		XPAL	P3		; P3=$xx3D
		JMP	L021A
;
L01AB:	XAE
		CCL
		ADI	$01
		XAE
		LD	E(P2)
		ST	@1(P1)
		JMP	L01A1
;
L01B6:	LDI	$61		; PAGE Command ?
		XRE
		JNZ	DEFINE	; jump if not PAGE
					; PAGE - permits a direct jump between RAM Buffer pages by entering
					; a single digit for the page required
		LDI	$CC
		ST	prompt(P2)	; Prompt=$CC
		XPPC	P3		; return
		HALT
		LD	keywrd(P2)	; retrieve Keyword (Page)
		ADI	$10		; add $10
		ST	curpH(P2)
		JMP	L0213
;
DEFINE:	LDI	$01		; DEFINE Command ?
		XRE
		JNZ	L01E0		; jump if not DEFINE Command
					; DEFINE - move cursor backwards to enclose a Block of data
		LDI	$DD
		ST	prompt(P2)	; Prompt=$DD
		LDI	$01
		ST	streg(P2)	; Status Line Status Register = $01
		LD	curpH(P2)	; copy Cursor Pointer to Alternate Cursor Pointer
		ST	acurpH(P2)
		LD	curpL(P2)
		ST	acurpL(P2)
		JMP	L0217
;
L01E0:	LDI	$55		; set Prompt to keypad Function Keycode entry
		ST	prompt(P2)
		XPPC	P3		; return
		HALT
		LDI	$00		; $SWAP Command ?
		ST	prompt(P2)
		LD	keywrd(P2)
		JNZ	FIX		; jump if not SWAP
					; SWAP - exchanges the Current Pointer with the Alternate Cursor
		LD	acurpH(P2)	; copy Alternate Cursor Pointer to Cursor Pointer
		ST	curpH(P2)
		LD	acurpL(P2)
		ST	curpL(P2)
		XPAH	P1		; copy P1(Cursor Pointer) to Alternate Cursor Pointer
		ST	acurpH(P2)
		XPAL	P1
		ST	acurpL(P2)
		JMP	L0213
;
FIX:		XAE
		LDI	$01		; $FIX Command ?
		XRE
		JNZ	SHIFT		; jump if not FIX
					; FIX - provides the alternate cursor function by copying the
					; Current Cursor to the Alternate Cursor
		XPAH	P1		; copy high byte
		ST	acurpH(P2)
		XPAH	P1		; put current cursor high byte back in P1
		XPAL	P1		; and low byte
		ST	acurpL(P2)
L020B:	XPAL	P1		; put current cursor low byte back in P1
		JMP	L0213
;
SHIFT:	LDI	$15		; SHIFT Command ?
		XRE
		JNZ	SEROUT	; jump if not SHIFT
					; SHIFT - (was FUNCTION in SOFTY1) gives access to the keypad second functions,
					; the prompt location will contain $55
L0213:	LDI	$00
		ST	prompt(P2)	; Prompt = 0
L0217:	LDI	$20		; setup subroutine call
		XPAL	P3
L021A:	LDI	$00
		XPAH	P3		; P3=$0020
		XPPC	P3		; call routine at $0021
;
SEROUT:	LDI	$02		; $SERIAL OUT Command ?
		XRE
		JNZ	PAROUT	; jump if not SERIAL OUT
					; SERIAL OUT - outputs a block of data serially
					; after selection press a single digit to select the baud rate:
					; (1=110, 3=300, 6=600, C=1200, F=2400)
		LDI	$BA
		ST	prompt(P2)	; Prompt=$BA (baud rate ?)
		XPPC	P3		; return
		HALT
		LDI	$06		; setup subroutine call
		XPAH	P3
		LDI	$D9
		XPAL	P3		; P3=06D9
L022F:	LD	@1(P3)
		ST	@1(P2)
		XPAL	P3
		JZ	L0239
		XPAL	P3
		JMP	L022F
;
L0239:	LDI	$00
		XPAL	P2		; P2=$xx00
		LDI	$00
		XPAL	P3
		LDI	$0A
		XPAH	P3		; P3=$0A00
		LD	keywrd(P2)
		XAE
		LDI	$01		; FIX Command ?
		XRE
		JNZ	SIN		; jump if not FIX
					; FIX - 
		LDI	$83
		XAE			; E=$83
		LDI	$11		; A=$11
		JMP	L0273
;
SIN:		LDI	$03		; $SERIAL IN Command ?
		XRE
		JNZ	RUN2		; jump if not SERIAL IN
					; SERIAL IN - receives a block of data from the serial input
					; after selection press a single digit to select the baud rate:
					; (1=110, 3=300, 6=600, C=1200, F=2400)
		LDI	$4E
		XAE			; E=$4E
		LDI	$06		; A=$06
		JMP	L0273
;
RUN2:		LDI	$06		; RUN Command ?
		XRE
		JNZ	L0269		; jump if not RUN
					; RUN - ??
		LDI	$10
		XAE			; E=$10
		LDI	$03		; A=$03
		JMP	L0273
;
L0269:	LDI	$0C		; $COPY Command ?
		XRE
		JNZ	L027F		; jump if not COPY
					; COPY - copies the contents of an EPROM in the Programming Socket
					; to RAM Buffer (screen)
		LDI	$72
		XAE			; E=$72
		LDI	$01		; A=$01
L0273:	ST	$13(P2)
		ST	$20(P2)
		LDE			; A=E
		ST	$11(P2)
		CCL			; clear carry
		ADI	$0E		; add $0E
		ST	$1E(P2)
L027F:	JMP	L0291
;
PAROUT:	LDI	$04		; $PARALLEL OUT Command ?
		XRE
		JNZ	SERIN		; jump if not PARALLEL OUT
					; PARALLEL OUT - ouputs Block of data to e.g. a printer,
					; each byts is transmitted as 2 ASCII characters with spaces in between
					; together with LF and CRs
		LDI	$40
		ST	-$5D(P2)
		LDI	$60
		ST	-$5C(P2)
		LDI	$A0
		XPAL	P3		; P3=$xxA0	$02A0 ?
L0291:	LD	curpH(P2)	; copy Cursor Pointer to P1
		XPAH	P1
		LD	curpL(P2)
		XPAL	P1
L0297:	LDI	$0D		; send a CR
		XPPC	P3
L029A:	LDI	$0D		; send a CR
		XPPC	P3
		LDI	$0A		; send a LF
		XPPC	P3
L02A0:	LD	0(P1)		; get byte to send
		SR			; shift upper nibble to lower nibble
		SR
		SR
		SR
		ADI	$36		; add $36
		XAE			; and transfer to E
		LD	E
		XPPC	P3		; send first digit
		LD	@1(P1)
		ANI	$0F		; AND with $0F to mask off lower nibble
		ADI	$2C		; add $2C
		XAE			; and transfer to E
		LD	E
		XPPC	P3		; send 2nd digit
		LDI	$20		; send a Space
		XPPC	P3
		XPAH	P1
		XAE			; E=P1H
		LD	acurpH(P2)
		XRE			; finished ?
		JNZ	L02CB
		LDE
		XPAL	P1
		XAE
		LD	acurpL(P2)
		XRE
		JZ	L027F+1	; jump to the middle of an instruction ?
		LDE
		XPAL	P1
		XAE
L02CB:	LDI	$10		; A=$10
		XRE			; XOR with E
		JZ	L027F+1	; jump to the middle of an instruction ?
		LDE
		XPAH	P1
		XPAL	P1
		XAE
		LDE
		XPAL	P1
		LDI	$0F		; A=$0F
		ANE			; AND with E to mask off lower nibble
		JNZ	L02A0
		LDE
		JZ	L0297
		JMP	L029A
;
L02DF:	.db	$30		; ASCII 0
		.db	$31		; ASCII 1
		.db	$32		; ASCII 2
		.db	$33		; ASCII 3
		.db	$34		; ASCII 4
		.db	$35		; ASCII 5
		.db	$36		; ASCII 6
		.db	$37		; ASCII 7
		.db	$38		; ASCII 8
		.db	$39		; ASCII 9
		.db	$41		; ASCII A
		.db	$42		; ASCII B
		.db	$43		; ASCII C
		.db	$44		; ASCII D
		.db	$45		; ASCII E
		.db	$46		; ASCII F
;
SERIN:	LDI	$03		; $SERIAL IN Command ?
		XRE
		JNZ	JMPPARIN	; jump if not SERIAL IN
					; SERIAL IN - ??
		LDI	$BA
		ST	prompt(P2)
		XPPC	P3		; return
		HALT
		LDI	$D9
		XPAL	P3
		LDI	$05
		XPAH	P3		; P3=$05D9
L0301:	LD	@1(P3)
		ST	@1(P2)
		XPAL	P3
		JZ	L030D
		XPAL	P3
		JMP	L0301
;
JMPPARIN:	JMP	PARIN		; jump to PARALLEL IN command
;
L030D:	XPAL	P3
		LDI	$0A
		XPAH	P3
		LDI	$00		; P3=$000A
		XPAL	P2		; P2=$xx00
		LD	keywrd(P2)	; load Cursor Speed Counter
		XAE			; and move to E
		LDI	$01		; A=$01
		XRE			; XOR with E
		JNZ	L0330
		LDI	$C2		; A=$C2
		ST	$0D(P2)
		ST	$21(P2)
		LDI	$08		; A=$08
		ST	$0F(P2)
		ST	$23(P2)
		LDI	$92		; A=$92
		ST	$18(P2)
		LDI	$11		; A=$11
		ST	$1A(P2)
L0330:	LDI	$03		; A=$03
		XRE			; XOR with E
		JNZ	L0349
		LDI	$28		; A=$28
		ST	$0D(P2)
		ST	$21(P2)
		LDI	$03		; A=$03
		ST	$0F(P2)
		ST	$23(P2)
		LDI	$5E		; A=$5E
		ST	$18(P2)
		LDI	$06		; A=$06
		ST	$1A(P2)
L0349:	LDI	$06		; A=$06
		XRE			; XOR with E
		JNZ	L0362
		LDI	$89		; A=$89
		ST	$0D(P2)
		ST	$21(P2)
		LDI	$01		; A=$01
		ST	$0F(P2)
		ST	$23(P2)
		LDI	$20		; A=$20
		ST	$18(P2)
		LDI	$03		; A=$03
		ST	$1A(P2)
L0362:	LDI	$0C		; A=$0C
		XRE			; XOR with E
		JNZ	L0375
		LDI	$BA		; A=$BA
		ST	$0D(P2)
		ST	$21(P2)
		LDI	$01		; A=$01
		ST	$1A(P2)
		LDI	$81		; A=$81
		ST	$18(P2)
L0375:	JMP	L0382
;
PARIN:	LDI	$05		; $PARALLEL IN Command ?
		XRE
		JNZ	CPYFIRM	; jump if not PARALLEL IN
					; PARALLEL IN - ??
		LDI	$77
		XPAL	P3		; setup subroutine call
		LDI	$06
		XPAH	P3		; P3=$0677
L0382:	XPPC	P3		; call subroutine at $0678
		XAE
		LDI	$70
		ANE
		XRI	$30
		JZ	L039F
		XRI	$70
		JNZ	L0382
		LDI	$0F
		ANE
		JZ	L0382
		CCL			; clear carry
		ADI	$09		; add decimal 9
		XAE
		LDI	$30
		ANE
		JNZ	L0382
		JMP	L03AA
;
L039F:	LDI	$0F
		ANE
		XAE
		LDE
		ADI	$06
		ANI	$10
		JNZ	L0382
L03AA:	ILD	prompt(P2)	; increment Prompt
		ANI	$01
		JZ	L03B9
		LDE
		RR
		RR
		RR
		RR
		ST	0(P1)
		JMP	L0382
;
L03B9:	LD	0(P1)
		ORE
		ST	@1(P1)
		JMP	L0382
;
L03C0:	LDI	$20		; setup subroutine call
		XPAL	P3
		LDI	$00
		XPAH	P3		; P3=$0020
		XPPC	P3		; call routine at $0021
;
CPYFIRM:	LDI	$09		; $COPYFIRM Command ? 
		XRE
		JNZ	DELETE	; jump if not COPYFIRM
					; COPYFIRM - copy contents of Softy 2 firmware to working RAM
		LDI	$00
		XPAL	P1
		LDI	$00
		XPAL	P3
		LDI	$00
		XPAH	P3		; P3=$0000 (Firmware EPROM)
		LDI	$18
		XPAH	P1		; P1=$1800 (RAM Buffer)
DOFIRM:	LDI	$10
		XAE			; E=$10
		LD	@1(P3)	; copy Firmware EPROM to RAM Buffer
		ST	@1(P1)
		XPAH	P1
		XAE			; E=P1H
		XRE
L03E2:	JZ	L03C0		; finished ?
		XAE			; restore P1H
		XPAH	P1
		JMP	DOFIRM	; continue copying
;
DELETE:	LDI	$1A		; $CLEAR BACKWARDS Command ? 
		XRE
		JNZ	CLEARFRWD		; jump if not CLEAR BACKWARDS
					; CLEAR BACKWARDS - writes $FF into the RAM Buffer behind the cursor
		LDI	$FF		; byte to CLEAR with
CLEARBACK:	ST	@-1(P1)	; store at cusor location (and decrement pointer)
		XPAH	P1
		XAE			; E=P1H
		LDI	$17
		XRE
L03F6:	JZ	L03E2		; finished ?
		XAE			; restore P1H
		XPAH	P1		; and A (=$FF)
		JMP	CLEARBACK	; continue CLEARing
;
CLEARFRWD:	LDI	$19		; $CLEAR FORWARDS ?
		XRE
		JNZ	GOSUB		; jump if not CLEAR FORWARDS
					; CLEAR FORWARDS - writes $FF into the RAM Buffer in front of the cursor	
L0401:	LDI	$10
		XAE			; E=$10
		LDI	$FF		; byte to CLEAR with
		ST	@1(P1)	; store at cursor location ( and increment pointer)
		XPAH	P1
		XAE			; E=P1H
		XRE
		JZ	L03F6		; finished ?
		XAE			; restore P1H
		XPAH	P1
		JMP	L0401		; continue
;
GOSUB:	LDI	$14		; GOSUB Command ?
		XRE
		JNZ	MATCH		; jump if not GOSUB
					; GOSUB - ??
		XPPC	P2
		JMP	L03C0
;
MATCH:	LDI	$0F		; $MATCH Command ?
		XRE
		JNZ	EXRAM		; jump if not MATCH
					; MATCH - highlights all occurances of the next byte to be entered
					; at the keypad
		LDI	$BB
		ST	prompt(P2)	; Prompt=$BB
		XPPC	P3		; return
		HALT
		LD	keywrd(P2)	; retrieve Keyword
		RR			; rotate to lower nibble ?
		RR
		RR
		RR
		XAE			; put result in E
		LDI	$01
		ANE			; AND with E
L042E:	JNZ	CLEARFRWD+1	; jump to the middle of an instruction ?
		XAE
		ST	prompt(P2)
		XPPC	P3		; return
		HALT
		LD	keywrd(P2)
		XAE			; E=Keyword
		LDI	$10
		ANE			; AND with $10
		JNZ	L042E		; jump if bit set
		LD	prompt(P2)
		ORE			; OR with E
		ST	prompt(P2)
		LD	curpH(P2)
		ANI	$1C		; AND with $1C
		XPAH	P1
		LDI	$00
		XPAL	P1		; P1=$xx00
L044A:	LD	prompt(P2)
		XAE
		LD	@1(P1)
		XRE
		JNZ	L045C
		LDI	$01
		CAS			; set Flag 0 (Cursor)
		LD	-1(P1)	; update cursor
		ST	-1(P1)
		LDI	$00
		CAS			; clear all Flags
L045C:	XPAH	P1
		XAE
		CCL			; clear Carry
		LD	curpH(P2)
		ADI	$04		; add 4
		ANI	$1C
		ORI	$10
		XRE
		JZ	L04E7
		XAE
		XPAH	P1
		JMP	L044A
;
EXRAM:	LDI	$18
		XPAH	P1
		LDI	$00
		XPAL	P1		; P1=$1800 (RAM Buffer)
		LDI	$00
		XPAL	P3		; P3=$xx00
		LDI	$0E		; EX-RAM Command ?
		XRE
		JNZ	COPY		; jump if not EX-RAM
					; $EX-RAM - copies the contents of the RAM Buffer to a
					; RAM in the Programming Socket
		LDI	$18
		XPAH	P3		; P3=$1800 (RAM Buffer)
		LDI	$10
		XPAH	P1		; P1=$1000 (Programming Socket)
DOEXRAM:	LDI	$10
		XAE			; E=$10
		LD	@1(P3)	; copy byte from RAM Buffer to Programming Socket
		ST	@1(P1)
		XPAH	P3
		XAE			; E=P3H
		XRE
		JZ	DOWN		; finished ?
		XAE			; restore P3H
		XPAH	P3
		JMP	DOEXRAM	; continue copying
;
COPY:		LDI	$0C		; $COPY Command ?
		XRE
		JNZ	UP		; jump if not COPY
					; COPY - transfers the contents of the Programming Socket
					; to the RAM Buffer
		LDI	$10
		XPAH	P3		; P3=$1000 (Programming Socket)
DOCOPY:	LDI	$10
		XAE			; E=$10
		LD	@1(P3)	; copy byte from Programming Socket to RAM Buffer
		ST	@1(P1)
		XPAH	P1
		XAE			; E=P3H
		XRE
		JZ	L04BB		; finished ?
		XAE			; restore P3H
		XPAH	P1
		JMP	DOCOPY	; continue copying
;
UP:		LDI	$17		; $UP Command ?
		XRE
		JZ	DOUPDOWN	; jump if UP

DOWN:		LDI	$18		; $DOWN Command ?
		XRE
		JNZ	COMPARE	; jump if not DOWN
					; UP and DOWN -
DOUPDOWN:	LDI	$0F
		ST	curspd(P2)	; Cursor Speed Counter=$0F
		LDE			; A=E
		ST	keywrd(P2)
L04BB:	JMP	L04FA
;
COMPARE:	LDI	$0A		; $COMPARE Command ?
		XRE
		JNZ	BURN		; jump if not COMPARE
					; COMPARE - compares the contents of an EPROM in the
					; Programming Socket with Working RAM (screen)
VERIFY:	ST	prompt(P2)	; Prompt=0
		LDI	$18
		XPAH	P1
		LDI	$00
		XPAL	P1		; P1=$1800 (RAM Buffer)
		LDI	$10
		XPAH	P3
		LDI	$00
		XPAL	P3		; P3=$1000 (Programming Socket)
DOCOMP:	LD	@1(P3)	; compare Programming Socket and RAM Buffer
		XOR	@1(P1)
		JNZ	DIFF		; jump if different
CNTCOMP:	XPAH	P1
		XAE
L04D8:	LDI	$10
		XRE
		JZ	L04FA		; finished ?
		XAE
		XPAH	P1
		JMP	DOCOMP	; continue COMPAREing
;
DIFF:		ILD	prompt(P2)	; increment differences found count
		XPAH	P1
		XAE			; E=P1H
		LD	curpH(P2)
L04E7:	XRE
		ANI	$1C
		JNZ	L04D8
		XAE
		XPAH	P1		; restore P1H
		LDI	$01
		CAS			; set Flag 0 (Cursor)
		LD	-1(P1)	; mark the difference
		ST	-1(P1)
		LDI	$00
		CAS			; clear all Flags
		JMP	CNTCOMP	; continue COMPAREing
;
L04FA:	LDI	$37		; setup subroutine call
		XPAL	P3
		LDI	$00
		XPAH	P3		; P3=$0037
		XPPC	P3		; call routine at $0038
;
BURN:		LDI	$0B		; $BURN Command ?
		XRE
		JNZ	RUN		; jump if not BURN
					; BURN - Program EPROM in Programming Socket from RAM buffer
		LDI	$18
		XPAH	P1		; P1=$1800 (RAM Buffer)
		LDI	$02
		CAS			; set Flag 1 (EPROM Vpp)
L050C:	LDI	$10
		XAE			; E=$10
		LDI	$FF		; A=$FF
		XOR	@1(P1)	; if RAM Buffer location is $FF
		JZ	FF		; no need to program
		XRI	$FF
		ST	-1(P1)
FF:		NOP			; delay ?
		NOP
		NOP
		XPAH	P1
		XAE			; E=P1H
		XRE
		JZ	L0525		; finished ?
		XAE			; restore P1H
		XPAH	P1
		JMP	L050C		; continue BURNing
;
L0525:	CAS			; clear flags
		JMP	VERIFY	; jump to COMPARE command to verify
;
RUN:		LDI	$06		; $RUN Command ?
		XRE
		JNZ	PRETEST	; jump if not RUN
					; RUN - hand control to a user program in the Programming Socket
		LDI	$10
		XPAH	P3
		LDI	$00
		XPAL	P3		; P3=$1000 (Programming Socket)
		XPPC	P3		; call routine at $1001
;
PRETEST:	LDI	$0D		; $PRETEST Command ?
		XRE
		JNZ	TRANSIN	; jump if not PRETEST
					; PRETEST - check an EPROM in the Programming Socket can be programmed
					; with the contents of the RAM Buffer i.e. can only program from 1 to 0
		ST	prompt(P2)	; Prompt=0 (reset count)
		LDI	$10
		XPAH	P3		; P3=$1000 (Programming Socket)
		LDI	$18
		XPAH	P1		; P1=$1800 (RAM Buffer)
DOPRETEST:	LD	@1(P1)	; load byte from RAM Buffer (and increment P1)
		XOR	0(P3)		; and compare with Programming Socket
		XAE			; put result in E (0 if the same)
		LDI	$FF		; A=$FF
		XOR	@1(P3)	; invert byte in Programming Socket (and increment P3)
		ANE			; AND with E to check can be programmed
		JNZ	NOPROG	; if not jump
		XPAH	P1
		XAE			; E=P1H
L054F:	LDI	$10		; A=$10
		XRE
		JZ	L0571		; finished ?
		XAE			; restore P1H
		XPAH	P1
		JMP	DOPRETEST	; continue PRETESTing
;
NOPROG:	ILD	prompt(P2)	; increment the count of non-programmable locations
		XPAH	P1
		XAE			; E=P1H
		LD	curpH(P2)
		XRE
		ANI	$1C
		JNZ	L054F
		XAE			; restore P1H
		XPAH	P1
		LDI	$01
		CAS			; set Flag 0 (Cursor)
		LD	-1(P1)	; mark non-programmable location
		ST	-1(P1)
		LDI	$00
		CAS			; clear all Flags
		JMP	DOPRETEST	; continue PRETESTing
;
L0571:	LDI	$37		; setup subroutine call
		XPAL	P3
		LDI	$00
		XPAH	P3		; P3=$0037
		XPPC	P3		; call routine at $0038
;
; Packing -  fill space between $0578 and $0584 with $FF
		.db	$FF,$FF,$FF,$FF,$FF,$FF
L057E:
		.db	$FF,$FF,$FF,$FF,$FF,$FF,$FF
;
TRANSIN:	LDI	$08		; $TRANSWIFT IN Command ?
		XRE
		JNZ	TRANSOUT	; jump if not TRANSWIFT IN
					; TRANSWIFT IN - 
		LDI	$AC
		XPAL	P3		; P3=$xxAC
L058D:	LDI	$30
		ST	prompt(P2)	; Prompt=$30
L0591:	XPPC	P3		; return
		LDI	$AA
		XRE			; compare with $AA
		JZ	L059C
		LDI	$55
		XRE			; compare with $55
		JNZ	L058D
L059C:	DLD	prompt(P2)	; decrement Prompt
		JNZ	L0591
L05A0:	XPPC	P3		; return
		LDI	$69
		XRE			; compare with $69
		JNZ	L05A0
L05A6:	XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		ST	@1(P1)
		XPAH	P1
		XAE			; E=P1H
		LDI	$10
		XRE			; compare with $10
		JZ	L05BB
		XAE			; restore P1H
		XPAH	P1
		JMP	L05A6
;
L05BB:	LDI	$18
		XPAH	P1		; P1=18xx
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
		XPPC	P3		; return
L05C6:	XOR	@1(P1)
		XPAH	P1
		XAE			; E=P1H
		LDI	$10
		XRE			; E=$10
		JZ	L05D3
		XAE			; restore P1H
		XPAH	P1
		JMP	L05C6
;
L05D3:	XAE			; restore P1H
		XPAH	P1
		ST	prompt(P2)
		JMP	L057E
;
L05D9:	XPPC	P3		; return
		LDI	$08
		ST	TRANSOUT	; ??
L05DE:	LDI	$00
		XAE
		SIO			; serial I/O
		LDE
		JNZ	L05DE
		LDI	$52
		DLY	$00		; delay 177uS (13+2*82+512*0)uS (13+2*A+512*DISP)
		SIO			; serial I/O
		XAE
		JNZ	L05DE
		LDI	$00
		XAE
L05F0:	LDI	$B2
		DLY	$00		; delay 369uS (13+2*178+512*0)uS (13+2*A+512*DISP)
		SIO			; serial I/O
		DLD	$0A(P0)
		JNZ	L05F0
		LDI	$52
		DLY	$00		; delay 177uS (13+2*82+512*0)uS (13+2*A+512*DISP)
		XAE
		JMP	L05D9
;
TRANSOUT:	LDI	$07		; $TRANSWIFT OUT Command ?
		XRE
		JNZ	L0671		; jump if not TRANSWIFT OUT
					; TRANSWIFT OUT - 
		LDI	$01
		XAE
		SIO			; serial I/O
		LDI	$60
		DLY	$00		; delay 49mS (13+2*1+512*96)uS (13+2*A+512*DISP)
		LDI	$BF
		XPAL	P3		; P3=$xxBF
		LDI	$20
		ST	prompt(P2)	; Prompt=$20
		LDI	$AA		; A=$AA
		ST	hexdif(P2)
L0618:	LD	prompt(P2)	; update Prompt
		JZ	L062E
		LDI	$AA		; A=$AA
		XAE
		DLD	prompt(P2)	; decrement Prompt
		JZ	L0627
		LDI	$0A		; A=$0A
		JMP	L0638
;
L0627:	LDI	$69
		XAE			; E=$69
		LDI	$02
		JMP	L0638
;
L062E:	LD	@1(P1)
		XAE
		LD	hexdif(P2)
		XRE
		ST	hexdif(P2)
		LDI	$01
L0638:	DLY	$00		; delay 15uS (13+2*1+512*0)uS (13+2*A+512*DISP)
		XPPC	P3		; return
		DLY	$00		; delay 15uS (13+2*1+512*0)uS (13+2*A+512*DISP)
		XPPC	P3		; return
		DLY	$00		; delay 15uS (13+2*1+512*0)uS (13+2*A+512*DISP)
		XPPC	P3		; return
		DLY	$00		; delay 15uS (13+2*1+512*0)uS (13+2*A+512*DISP)
		XPPC	P3		; return
		DLY	$00		; delay 15uS (13+2*1+512*0)uS (13+2*A+512*DISP)
		XPPC	P3		; return
		DLY	$00		; delay 15uS (13+2*1+512*0)uS (13+2*A+512*DISP)
		XPPC	P3		; return
		DLY	$00		; delay 15uS (13+2*1+512*0)uS (13+2*A+512*DISP)
		XPPC	P3		; return
		DLY	$00		; delay 15uS (13+2*1+512*0)uS (13+2*A+512*DISP)
		XPPC	P3		; return
		XPAH	P1
		XAE			; E=P1H
		LDI	$10
		XRE
		JZ	L065B
		XAE			; restore P1H
		XPAH	P1
		JMP	L0618
;
L065B:	XAE
		XPAH	P1		; restore P1H
		LD	prompt(P2)
		JNZ	L066C
		LDI	$AA
		ST	prompt(P2)	; Prompt =$AA
		LD	hexdif(P2)
		XAE
		LDI	$0C		; A=$0C
		JMP	L0638
;
L066C:	LDI	$1E
		DLY	$00		; delay 73uS (13+2*30+512*0)uS (13+2*A+512*DISP)
		XPPC	P3		; return from subroutine call
;
L0671:	LDI	$20		; setup subroutine call at $0021
		XPAL	P3
		LDI	$00
		XPAH	P3		; P3=$0020
		XPPC	P3		; call subroutine at $0021
;
L0678:	LDI	$00		; subroutine ?
		ST	-$5E(P2)
		LDI	$40
		ST	-$5D(P2)
		LDI	$20
		ST	-$5C(P2)
L0684:	LD	-$72(P2)
		JZ	L0684
		LD	-$60(P2)
		XPPC	P3		; return
		JMP	L0684
;
; Packing -  fill space between $068D and $06C4 with $FF
		.db	$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
		.db	$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
		.db	$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
		.db	$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
		.db	$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
		.db	$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
		.db	$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
;
L06C5:	NOP
		LDI	$0F
		ST	matchb(P2)
L06CA:	LDI	$01
		XAE			; E=1
		SIO
		DLY	$01		; delay 527uS (13+2*1+512*1)uS (13+2*A+512*DISP)
		SIO
		DLY	$01		; delay 527uS (13+2*1+512*1)uS (13+2*A+512*DISP)
		DLD	matchb(P2)
		JNZ	L06CA
		JMP	KEYSCAN
;
L06D9:	XPPC	P3		; return
		XRI	$FF		; subroutine ?
		XAE
L06DD:	LDI	$00
		XAE
		SIO			; serial I/O
		XAE
		JZ	L06DD
		LDI	$01
		XAE
		SIO			; serial I/O
		XAE
		LDI	$B1
		DLY	$00		; delay 90.637mS (13+2*0+512*177)uS (13+2*A+512*DISP)
		LDI	$0B
		ST	L0700
L06F1:	SIO			; serial I/O
		LDE
		ANI	$7F
		XAE
		LDI	$A2
		DLY	$00		; delay 83.981mS (13+2*0+512*164)uS (13+2*A+512*DISP)
		DLD	$05(P0)
		JNZ	L06F1
		JMP	L06D9
;
L0700:	XPPC	P3		; return from subroutine call
L0701:	JMP	L06C5
;
L0703:	XPPC	P3		; return from subroutine call
;
;					; Scan Keyboard Routine
KEYSCAN:	XPAH	P1		; P1 is a copy of the cursor pointer
		ST	curpH(P2)	; save the high byte
		XPAH	P1		; and restore P1
		LD	curpH(P2)
		SR			; shift 1 bit right to provide screen Page,RAM/EPROM selects
		ST	PORTA(P2)	; write screen Page,RAM/EPROM selects and clear keyboard Row
		LDI	$85
		CAS			; set Flag 0 (Cursor), Flag 2 (HALT Latch) and Carry
		XPAL	P1		; A=P1 low byte
		ST	curpL(P2)	; save as Cursor Pointer low byte
		XAE			; E=Cursor Pointer low byte
		LD	acurpL(P2)	; A=Alternate Cursor Pointer low byte
		CAE			; calculate the difference
		ST	hexdif(P2)	; and save as Hex Diference
		XAE			; A=Cursor Pointer low byte
		XPAL	P1		; restore P1 cursor pointer low byte
		LD	0(P1)		; update Cursor position
		ST	0(P1)
		LD	keywrd(P2)
		XAE			; E = last key pressed
		LDI	$17		; LEFT ?
		XRE
		JZ	L072C		; jump if LEFT
		LDI	$18		; RIGHT ?
		XRE
		JNZ	L074D		; jump if not RIGHT
L072C:	ILD	curspd(P2)	; LEFT or FORWARD - increment and load Cursor Speed Counter
		XAE			; transfer to E
		LDI	$F0
		ANE			; A AND E - clear lower nibble
		JZ	L0741		; jump if high nibble was zero
		LDI	$0F
		ANE			; A AND E - clear high nibble
		JZ	L0741		; jump if low nibble was zero
		ORI	$30		; set bits 4 and 5
		ST	curspd(P2)	; and update Cursor Speed Counter
L073D:	LD	@1(P3)	; increment P3 ??
L073F:	JMP	L0700		; return from subroutine call
;
L0741:	DLY	$FF		; delay 130mS (13+2*0+512*255)uS (13+2*A+512*DISP)
		DLY	$FF		; delay 130mS (13+2*0+512*255)uS (13+2*A+512*DISP)
		LD	PORTB(P2)	; read keyboard column
		ORI	$80		; set bit 7
		XRI	$FF		; invert all bits
		JNZ	L073D		; result will be non-zero if key pressed, return
L074D:	LD	PORTB(P2)	; read keyboard column
		ORI	$80		; set bit 7
		XRI	$FF		; invert all bits
		XAE			; put result in E
		DLY	$10		; debounce 8.2mS (13+2*0+512*16)uS (13+2*A+512*DISP)
		LD	PORTB(P2)	; reread keyboard column
		ORI	$80		; set bit 7
		XRI	$FF		; invert all bits
		ORE			; OR with previous value read
		JNZ	L074D		; result non-zero if key pressed, round again waiting for release
		LDI	$00		; key released
		ST	curspd(P2)	; clear Cursor Speed Counter
		ST	keywrd(P2)	; clear Keyword
		IEN			; enable interrupts
		XPPC	P3		; and return
;
					; Interrupt Service Routine
		CAS			; clear all flags
		LD	PORTB(P2)	; read keyboard column
		ORI	$80		; set bit 7
		XRI	$FF		; invert all bits
		JNZ	L0774
L0770:	ST	@-2(P3)	; decrement P3 ??
		JMP	L0703		; return ??
;
L0774:	SR
		JZ	L077D		; jump if zero
		XAE			; save A in E
		ILD	keywrd(P2)	; increment Keyword
		XAE			; retrieve A
		JMP	L0774
;
L077D:	CCL			; clear carry ready for addition
		LDI	$FF
L0780:	SR
		JZ	L0770
		ST	-$60(P2)
		XAE
		LD	PORTB(P2)	; read keyboard column
		ORI	$80		; set bit 7
		XRI	$FF		; invert all bits
		JNZ	L073F		; return ??
		LD	keywrd(P2)
		ADI	$07		; add $07 to Keyword (7 keys in a Row)
		ST	keywrd(P2)
		XAE
		JMP	L0780		; and round again
;
; Packing - fill space between $0797 and $079F with $FF
		.db	$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF
		.db	$FF
;
L07A0:	XPPC	P3		; return
		ST	-$60(P2)
L07A3:	LD	-$72(P2)
		JZ	L07A3
		JMP	L07A0
;
; Packing - fill space between $07A9 and $07AB with $FF
		.db	$FF,$FF,$FF
;
L07AC:	XPPC	P3		; return
L07AD:	CSA
		ANI	$20
		JNZ	L07AD
L07B2:	CSA			; A=SR
		ANI	$20		; mask Sense B
		JZ	L07B2		; jump if not high
		LDI	$80
		DLY	$00		; delay 269uS (13+2*128+512*0)uS (13+2*A+512*DISP)
		SIO			; serial I/O
		LDE
		JMP	L07AC
;
L07BF:	XPPC	P3		; return
		LDI	$01
		ANE
		SIO			; serial I/O
		JZ	L07D3
		LDI	$61
		DLY	$00		; delay 205S (13+2*97+512*0)uS (13+2*A+512*DISP)
		LDI	$00
		XAE
		SIO			; serial I/O
		XAE
		LDI	$6E
		DLY	$00		; delay 233uS (13+2*110+512*0)uS (13+2*A+512*DISP)
L07D3:	LDI	$67
		DLY	$00		; delay 219uS (13+2*103+512*0)uS (13+2*A+512*DISP)
		XAE
		SIO			; serial I/O
		XAE
		LDI	$57
		JMP	L07BF
;
L07DE:	LDI	$03
		ST	endarc(P2)
L07E2:	LDI	$10
		XAE
		LDI	$FF
		XOR	@1(P1)
		JNZ	L07F0
		DLD	endarc(P2)
		JNZ	L07E2
		XPPC	P3		; return
;
L07F0:	XPAH	P1
		XAE			; E=P1H
		XRE
		JZ	L07F9
		XAE			; restore P1H
		XPAH	P1
		JMP	L07DE
;
L07F9:	LDI	$00		; setup subroutine call
		XPAH	P3
		LDI	$20
		XPAL	P3		; P3=$0020
		XPPC	P3		; call routine at $0021