;
; SOFTY 1 Firmware
;
; From an original SOFTY 1 owned by Derek at bygonebytes.co.uk
;
; Extracted from 2708 EPROM labelled '304'
;
; Formatted for the SB-Assembler (https://www.sbprojects.net/sbasm/)
;
; Chris Oddy	Dec 2020
;
	.CR	scmp			; 8060 running at 4MHz (microcycle time = 1uS)
	.LF	softy1.list		; listing file
	.TF	softy1.bin		; object file
;
; Registers
;
;	Pointer Register 1 (P1)
;	Pointer Register 2 (P2)	RAM pointer, set to $0700 to point at IC21 RAM
;					between $0700 and $07FF and with negative offsets
;					at IC21 I/O between $0620 and $06A4
;	Pointer Register 3 (P3)	subroutine pointer
;
; Processor Input/Outputs
;
; 	Flag 0			cursor write
;	Flag 1			Programming socket Vpp pulse enable
;	Flag 2			disables keypad
;	SENSE-A			8154 Interrupt (not used ?)
;	SENSE-B			Serial Input
;	SIN				Serial Input
;	SOUT				Serial Output
;
; 8154 I/O ($0680 to $06A4, mirrored at $0780 to $07A4))
;
; (offset from P2: $0700)
PORTA 	.EQ	-$60		; Port A Data Register (address $06A0)
PORTB 	.EQ	-$5F		; Port B Data Register (address $06A1)
ODRA 		.EQ	-$5E		; Port A Output Definition Register (address $06A2)
ODRB 		.EQ	-$5D		; Port B Output Definition Register (address $06A3)
					; Port A Set Bit 0 (address $0790)
					; Port A Set Bit 1 (address $0791)
					; Port A Set Bit 2 (address $0792)
					; Port A Set Bit 3 (address $0793)
					; Port A Set Bit 4 (address $0794)
					; Port A Set Bit 5 (address $0795)
					; Port A Set Bit 6 (address $0796)
					; Port A Set Bit 7 (address $0797)
;
; Port A:				PA0 screen Page select (output)
;					PA1 screen EPROM (low) or RAM (high) select (output)
;					PA3 and PA4 not used, avaliable on edgeconnector
;					PA5 to PA7 keyboard column scan (outputs)
; Port B:				PB0 to PB7 keyboard row scan (inputs) PB7 not used, avaliable on edgeconnector
;
; 8154 RAM 'Working RAM' ($0700 to $077F)
scrtch	.EQ	0		; $0700 Scratchpad
;					; $0701
;
; Status Line (top line of display)
; (offsets from P2 $0700)
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 (not used)
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	#$06
		XPAH	P2
		LDI	#$70
		XPAL	P2		; P2 = $0670
L0007:	ST	@1(P2)	; (A = 0), clear $0670 to $06FF
		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	#$0C		; cursor pointers high byte=$0C (P2=$0700 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)		; $0700=$3E
		LD	curpH(P2)	; copy cursor pointer to P1
		XPAH	P1		; high byte
		LD	curpL(P2)
		XPAL	P1		; low byte
SCANKEYP3:	LDI	#$03		; setup subroutine call
		XPAH	P3
		LDI	#$3A
		XPAL	P3		; P3=$033A
SCANKEY:	XPPC	P3		; call keyboard scan routine
		LD	keywrd(P2)	; 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	endarc(P2)	; increment End Around Carry, 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	endarc(P2)	; clear End Around Carry (reset to 1st digit for next time)
		LDI	#$21		; Ex Command ?
		XRE			
		JNZ	L007A		; jump if not Ex
					; Ex Command ??
		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
L0078:	JMP	SCANKEYP3	; call keyboard scan routine (restoring P3)
;
L007A:	LDI	#$11		; $FORWARD Command ?
		XRE
		JNZ	L0086		; jump if not FORWARD
		CAS			; clear SR
		LD	0(P1)		; clear Cursor at Cursor Pointer
		ST	@1(P1)
L0084:	JMP	L0078		; jump to call keyboard scan routine (restoring P3)
;
L0086:	LDI	#$01		; $FIX Command ?
		XRE
		JNZ	L0096		; jump if not FIX
		LD	streg(P2)	; load Status Line Status Register
		CAS			; and transfer to SR
		LD	0(P1)		; update Cursor at cursor pointer
		ST	0(P1)
		LD	@-1(P1)	; decrement cursor pointer
		JMP	L0084		; jump to call keyboard scan routine (restoring P3)
;
L0096:	LDI	#$FF
		ST	prompt(P2)	; Mode Flag=$FF (Function pressed)
		XPPC	P3		; return from subroutine call (get Function)
		LD	keywrd(P2)	; retrieve Keyword
		JZ	EXIT		; if 0 Exit pressed
		XAE			; transfer keyword to E
		LDI	#$13		; $Function pressed again ?
		XRE
		JNZ	CLEAR		; jump if not Function, otherwise clear Function state
;
EXIT:		LDI	0		; $EXIT Command
		ST	prompt(P2)	; Mode Flag=0
		CAS			; copy to status
		XPAL	P1		; P1L=0
		LDI	#$0C
		XPAH	P1		; P1=$0C00 (Working RAM)
CLRCUR:	LD	0(P1)		; clear Cursor memory
		ST	@1(P1)
		XPAH	P1
		JZ	CURTP1	; if zero copy Cursor Pointer to P1
		XPAH	P1
		JMP	CLRCUR	; continue clearing cursor memory
;
CURTP1:	LD	curpH(P2)	; copy Cursor Pointer to P1
		XPAH	P1
		LD	curpL(P2)
		XPAL	P1
		JMP	L0084		; jump to call keyboard scan routine (restoring P3)
;
CLEAR:	LDI	#$0F		; $CLEAR Command ?
		XRE
		JNZ	FIX		; jump if not CLEAR
					; CLEAR - fills Working RAM with $FF from the Current Cursor
DOCLR:	LDI	#$FF
		ST	@1(P1)	; write $FF to cursor pointer location, increment pointer
		XPAH	P1
		JZ	CURTP1	; finished ?
		XPAH	P1		; restore high byte
		JMP	DOCLR		; keep CLEARing
;
FIX:		LDI	#$01		; $FIX Command ?
		XRE
		JNZ	DEFINE	; jump if not FIX
					; FIX - copies current Cursor Pointer (P1) to Alternate Cursor
CPACUR:	XPAH	P1		; copy high byte
		ST	acurpH(P2)
		XPAH	P1		; restore P1
		XPAL	P1
		ST	acurpL(P2)	; and low byte
		XPAL	P1		; restore P1
L00DC:	JMP	EXIT		; jump to EXIT
;
DEFINE:	LDI	#$02		; $DEFINE Command ?
		XRE
		JNZ	SHIFT		; jump if not DEFINE
					; DEFINE - defines a block of data
		LDI	#$01
		ST	streg(P2)	; Status Line Status Register=1 (set Flag 0 - cursor write)
		JMP	CPACUR	; and copy cursor to Alternate Cursor
;
SHIFT:	LDI	#$03		; $SHIFT Command ?
		XRE
		JNZ	STORE		; jump if not SHIFT
					; SHIFT - moves a block of data
L00EE:	XPPC	P3		; return from subroutine call
		LD	keywrd(P2)	; retrieve Keyword
		XAE
		LDI	#$11		; $FORWARD Command ?
		XRE
		JNZ	BACK		; jump if not FORWARD
					; FORWARD - move cursor forward
		ILD	hexdif(P2)	; increment Hex Difference
		XAE			; and put result in E
		LD	E(P1)		; load location
		ST	prompt(P2)	; Mode Flag
L00FE:	LDI	#$01
		CAS			; set Flag 0 (Cursor)
		DLD	hexdif(P2)	; decrement Hex Difference
		XAE			; and transfer result to E
		LD	E(P1)		; load location
		XAE			; transfer to E
		ADI	#$01		; add 1 to A
		XAE			; and transfer to E
		ST	E(P1)		; set Cursor
		XAE
		JNZ	L00FE		; continue
		CAS			; clear Flag 0 (Cursor)
		NOP
		LD	prompt(P2)	; Mode Flag
		ST	@1(P1)	; clear Cursor
		ILD	acurpL(P2)
		JMP	L00EE		; and return
;
BACK:		LDI	#$10		; $BACK Command ?
		XRE
		JZ	L0124		; jump if BACK
L011E:	LDI	#$00		; A=0
		ST	streg(P2)	; Status Line Status Register=0 (clear Flags)
		JMP	L00DC
;
					; BACK - move cursor backwards
L0124:	LD	-1(P1)
		ST	prompt(P2)
		ILD	hexdif(P2)	; increment Hex Difference
		LDI	#$00
		XAE			; E=0
L012D:	LDI	#$01
		CAS			; set Flag 0 (Cursor) and clear Carry
		LD	E(P1)
		XAE
		ADI	#$FF		; add $FF (-1)
		XAE
		ST	E(P1)
		CCL			; clear carry
		XAE
		ADI	#$02		; add 2
		XAE
		LD	hexdif(P2)	; Hex Difference
		XRE
		JNZ	L012D
		CAS			; clear Flag 0 (Cursor)
		DLD	hexdif(P2)
		XAE
		LD	prompt(P2)	; Mode Flag
		ST	E(P1)
		DLD	acurpL(P2)	; Alternate Cursor Pointer low byte
		LD	@-1(P1)
		JMP	L00EE		; and return
;
STORE:	LDI	#$04		; $STORE Command
		XRE
		JNZ	SWAP		; jump if not STORE
					; STORE - lifts a defined block into the Scratchpad
		XAE
		ILD	hexdif(P2)	; Hex Difference
L0158:	LD	E(P1)
		XAE
		CCL			; clear carry
		ADI	#$01		; add 1
		XAE
		ST	E(P2)
		LD	hexdif(P2)	; Hex Difference
		XRE
		JNZ	L0158
		XAE
		ST	$6F(P2)
		ILD	hexdif(P2)	; Hex Difference
		XAE
		LDI	#$90
		ST	E(P2)
		ILD	hexdif(P2)	; Hex Difference
		XAE
		LDI	#$00
		CAS			; clear all flags
		CAD	hexdif(P2)	; complement and add Hex Difference
		ST	E(P2)
L017A:	JMP	L011E
;
SWAP:		LDI	#$0E		; $SWAP Command ?
		XRE
		JNZ	GOSUB		; jump if not SWAP
					; SWAP - swaps Current Cursor and Alternate Cursor
		LD	acurpH(P2)	; copy Alternate Cursor to Current Cursor
		ST	curpH(P2)
		LD	acurpL(P2)
		ST	curpL(P2)
		XPAH	P1		; copy Current Cursor to Alternate Cursor
		ST	acurpH(P2)
		XPAL	P1
		ST	acurpL(P2)
L018F:	JMP	L017A
;
GOSUB:	LDI	#$12		; $GOSUB Command ?
		XRE
		JNZ	MATCH		; jump if not GOSUB
					; GOSUB - 
		XPPC	P2		; call subroutine at Current Cursor location
		JMP	L018F
;
MATCH:	LDI	#$0D		; $MATCH Command ?
		XRE
		JNZ	INSERT	; jump if not MATCH
					; MATCH - 
		XPPC	P3		; return from subroutine
		LD	keywrd(P2)
		RR			; rotate to lower nibble ?
		RR
		RR
		RR
		XAE			; put result in E
		LDI	#$01
		ANE			; AND with E
L01A9:	JNZ	$0179		; jump to the middle of an instruction ?
		XAE
		ST	matchb(P2)	; save value to Matchbyte
		XPPC	P3		; return from subroutine
		LD	keywrd(P2)
		XAE			; E=Keyword
		LDI	#$10
		ANE			; AND with $10
		JNZ	L01A9		; jump if bit set
		LD	matchb(P2)
		ORE			; OR with E
		ST	matchb(P2)
		XAE
		LDI	#$0C
		XPAH	P1
		LDI	#$00
		XPAL	P1		; P1=$0C00 (Working RAM)
DOMATCH:	LD	@1(P1)
		XRE			; compare with E (Matchbyte)
		JNZ	NOMATCH	; jump if no match
		LDI	#$01		; a match
		CAS			; set Flag 0 (Cursor)
		LD	-1(P1)	; set cursor at that location
		ST	-1(P1)
		LDI	#$00
		CAS			; clear all flags
NOMATCH:	XPAH	P1
		JZ	L023D		; finished ?
		XPAH	P1
		JMP	DOMATCH	; continue looking for a match
;
INSERT:	LDI	#$05		; $INSERT Command ?
		XRE
		JNZ	COPY		; jump if not INSERT
					; INSERT - writes the block in Scratchpad back to the
					; current cursor location
		XAE			; E=0 (A=0)
DOINSERT:	LD	$6F(P2)	; byte before curpH ?
		XRE
		JZ	L01EE		; jump if result zero
		XAE
		CCL			; clear carry
		ADI	#$01		; add 1
		XAE			; put result in E
		LD	E(P2)
		ST	@1(P1)	; store at cursor pointer location and increment
		JMP	DOINSERT	; keep going
;
L01EE:	LDI	#$26		; setup subroutine call
		XPAL	P3
		LDI	#$00
		XPAH	P3		; P3=$0026
		XPPC	P3		; call keyboard scan routine SCANKEYP3
;
COPY:		LDI	#$0C
		XPAH	P1
		LDI	#$00
		XPAL	P1		; P1=$0C00 (Working RAM)
		LDI	#$00
		XPAL	P3		; P3=$xx00
		LDI	#$0C		; $COPY Command ?
		XRE
		JNZ	COMP		; jump if not COPY
					; COPY - copies the contents of an EPROM in the Programming Socket
					; to Working RAM (screen)
		LDI	#$08
		XPAH	P3		; P3=$0800 Programming Socket
DOCOPY:	LD	@1(P3)	; copy Programming Socket to Working RAM ($0C00)
		ST	@1(P1)
		XPAH	P1
		JZ	VERIFY	; finished ?
		XPAH	P1
		JMP	DOCOPY	; continue COPYing
;
COMP:		LDI	#$0A		; $COMP Command ?
		XRE
		JNZ	BURN		; jump if not COMP
					; COMP - compares the contents of an EPROM in the
					; Programming Socket with Working RAM (screen)
VERIFY:	ST	prompt(P2)	; Prompt=0
		LDI	#$0C
		XPAH	P1
		LDI	#$00
		XPAL	P1		; P1=$0C00 (Working RAM)
		LDI	#$08
		XPAH	P3
		LDI	#$00
		XPAL	P3		; P3=$0800 Programming Socket
DOCOMP:	LD	@1(P3)	; compare Programming Socket and Working RAM
		XOR	@1(P1)
		JNZ	DIFF		; jump if different
CNTCOMP:	XPAH	P1
		JZ	L023D		; finished ?
		XPAH	P1
		JMP	DOCOMP	; continue COMParing
;
DIFF:		LDI	#$01		; difference found
		CAS			; set Flag 0 (Cursor)
		LD	-1(P1)	; mark the difference
		ST	-1(P1)
		LDI	#$00
		CAS			; clear all flags
		ILD	prompt(P2)	; increment Mode Flag as a count of differences found
		JMP	CNTCOMP	; continue COMParing
;
L023D:	LDI	#$20		; setup subroutine call
		XPAL	P3
		LDI	#$00
		XPAH	P3		; P3=$0020
		XPPC	P3		; call routine at $0021
;
BURN:		LDI	#$0B		; $BURN Command ?
		XRE
		JNZ	RECORD	; jump if not BURN
					; BURN - Program EPROM in Programming Socket from Working RAM
		LDI	#$00		; A=0
L024B:	ST	prompt(P2)	; Prompt=0
		DLY	#$FF		; delay 130mS (13+2*0+514*255)uS
		DLY	#$FF		; delay 130mS (13+2*255+514*255)uS
		LDI	#$02
		CAS			; set Flag 1 (Programming Socket Vpp enable)
		LDI	#$08
		XPAH	P3		; P3=$0800 (Programming Socket)
		LDI	#$0C
		XPAH	P1		; P1=$0C00 (Working RAM)
DOBURN:	LD	@1(P1)	; read Working RAM and increment P1
		ST	@0(P3)	; write to Programming Socket
		LD	@1(P3)	; read back from Programming Socket and increment P3
		XPAH	P1
		JZ	L0266		; finished ?
		XPAH	P1
		JMP	DOBURN	; continue BURNing
;
L0266:	CAS
		DLY	#$FF		; delay 130mS (13+2*0+514*255)uS
		LD	prompt(P2)
		DAI	#$01		; decimal add 1
		JNZ	L024B		; finished ?
		JMP	VERIFY	; yes - jump to COMP command to verify
;
RECORD:	LDI	#$07		; $RECORD Command ?
		XRE
		JNZ	RECALL	; jump if not RECORD
					; RECORD - transmits the contents of Working RAM in serial form
		LDI	#$E1
		XPAL	P3		; P3=$03E1
		LDI	#$20
		ST	prompt(P2)	; Mode Flag=$20
		LDI	#$AA
		ST	hexdif(P2)	; Hex Difference=$AA
L0281:	LD	prompt(P2)
		JZ	L0291		; finished ?
		LDI	#$AA
		XAE			; E=$AA
		DLD	prompt(P2)	; decrement and load Mode Flag
		JNZ	L028F		; return
		LDI	#$69
		XAE			; E=$69
L028F:	JMP	L0299		; return
;
L0291:	LD	@1(P1)
		XAE
		LD	hexdif(P2)
		XRE
		ST	hexdif(P2)
L0299:	XPPC	P3		; return from subroutine
		DLY	#$00
		XPPC	P3		; return from subroutine
		DLY	#$00
		XPPC	P3		; return from subroutine
		DLY	#$00
		XPPC	P3		; return from subroutine
		DLY	#$00
		XPPC	P3		; return from subroutine
		DLY	#$00
		XPPC	P3		; return from subroutine
		DLY	#$00
		XPPC	P3		; return from subroutine
		DLY	#$00
		XPPC	P3		; return from subroutine
		XPAH	P1
		JZ	L02B5
		XPAH	P1
		JMP	L0281
;
L02B5:	XPAH	P1
		LD	prompt(P2)
		JNZ	L02C3
		LDI	#$AA
		ST	prompt(P2)	; Mode Flag=$AA
		LD	hexdif(P2)
		XAE
		JMP	L0299
;
L02C3:	LDI	#$20		; setup subroutine call
		XPAL	P3
		LDI	#$00
		XPAH	P3		; P3=$0020
		XPPC	P3		; call routine at $0021
;
RECALL:	LDI	#$08		; $RECALL Command ?
		XRE
		JNZ	RUN		; jump if not RECALL
					; RECALL - reads serial input into Working RAM
		LDI	#$CE
		XPAL	P3		; P3=$03CE
L02D2:	LDI	#$30
		ST	prompt(P2)	; Mode Flag=$30
L02D6:	XPPC	P3		; return from subroutine call
		LDI	#$AA
		XRE			; E=$AA
		JZ	L02E1
		LDI	#$55
		XRE			; E=$55
		JNZ	L02D2
L02E1:	DLD	prompt(P2)
		JNZ	L02D6
L02E5:	XPPC	P3		; return from subroutine call
		LDI	#$69
		XRE			; E=$69
		JNZ	L02E5
L02EB:	XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
		ST	@1(P1)
		XPAH	1
		JZ	L02FB
		XPAH	P1
		JMP	L02EB
;
L02FB:	LDI	#$0C
		XPAH	P1		; P1H=$0C
		XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
		XPPC	P3
L0306:	XOR	@1(P1)
		XPAH	P1
		JZ	L030E
		XPAH	P1
		JMP	L0306
;
L030E:	XPAH	P1
		ST	prompt(P2)
L0311:	JMP	L02C3
;
RUN:		LDI	#$06		; $RUN Command ?
		XRE
		JNZ	FIRM		; jump if not RUN
					; RUN - hand control to a user program in the Programming Socket
		LDI	#$08
		XPAH	P3
		LDI	#$00
		XPAL	P3		; P3=$0800 (Programming Socket)
		XPPC	P3		; call routine at $0801 in Programming socket
;
FIRM:		LDI	#$09		; $FIRM ?
		XRE
		JNZ	L0311		; jump if not FIRM
					; FIRM - copy contents of Softy 1 Firmware EPROM to Working RAM
		LDI	#$00
		XPAL	P1
		LDI	#$00
		XPAL	P3
		LDI	#$00
		XPAH	P3		; P3=$0000 (Firmware EPROM)
		LDI	#$0C
		XPAH	P1		; P1=$0C00 (Working RAM)
DOFIRM:	LD	@1(P3)	; copy Firmware EPROM to Working RAM
		ST	@1(P1)
		XPAH	P1
		JZ	L0311		; finished ? (reached $0000)
		XPAH	P1
		JMP	DOFIRM	; continue copying
;
L033A:	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	#$81
		CAS			; set Flag 0 (Cursor) 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 Difference
		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	#$10		; LEFT ?
		XRE
		JZ	L0364		; jump if LEFT
		LDI	#$11		; RIGHT ?
		XRE
		JNZ	L0380		; jump if not RIGHT
L0364:	ILD	curspd(P2)	; LEFT or RIGHT - increment and load Cursor Speed Counter
		XAE			; transfer to E
		LDI	#$F0
		ANE			; A AND E - clear lower nibble
		JZ	L0376		; jump if high nibble was zero
		LDI	#$0F
		ANE			; A AND E - clear high nibble
		JZ	L0376		; jump if low nibble was zero
		ORI	#$30		; set bits 4 and 5
		ST	curspd(P2)	; and update Cursor Speed Counter
L0374:	JMP	L033A		; return from subroutine call
;
L0376:	DLY	#$FF		; delay 131mS (13+514*255)uS
		DLY	#$FF		; delay 131mS (13+514*255)uS
		LD	PORTB(P2)	; read keyboard column
		XRI	#$FF		; invert all bits
		JNZ	L033A		; result will be non-zero if key pressed - return
L0380:	LD	PORTB(P2)	; read keyboard column
		XRI	#$FF		; invert all bits
		XAE			; put result in E
		DLY	#$20		; debounce 16.4mS (13+514*32)uS
		LD	PORTB(P2)	; reread keyboard column
		XRI	#$FF		; invert all bits
		ORE			; OR with previous value read
		JNZ	L0380		; result non-zero if key pressed, round again waiting for release
L038E:	LDI	#$04		; key released
		CAS			; set Flag 2 (suspend CPU)
		LDI	#$00		; resumes when a key has been pressed
		ST	curspd(P2)	; clear Cursor Speed Counter
		LDI	#$00
		CAS			; clear all flags
		ST	keywrd(P2)	; clear Keyword
		LD	PORTB(P2)	; read keyboard column
		XRI	#$FF		; invert all bits
		XAE			; put result in E
		DLY	#$20		; debounce 0.56mS (13+2*?+514*32)uS
		LD	PORTB(P2)	; read keyboard column
		XRI	#$FF		; invert all bits
		ANE			; AND with previous value read
		JZ	L038E		; if not the same bouncing so round again
L03A8:	SR			; shift right to lose LSB
		JZ	L03B1		; if zero then we have found the column bit that was active
		XAE			; not zero - save A in E
		ILD	keywrd(P2)	; increment Keyword (Column value)
		XAE			; retrieve A
		JMP	L03A8		; and go around again
;
L03B1:	LDI	#$98
		ST	prompt(P2)	; Mode Flag=(1001 1000)
L03B5:	DLD	prompt(P2)	; decrement Mode Flag
		XAE			; E=Mode Flag
		LDI	#$92
		XRE			; A=(E EOR 1001 0010)
		JZ	L038E		; suspend CPU ?
		ST	E(P2)		; Set keyboard Row ($0790 for bit-0 to $0797 for bit-7)
		LD	PORTB(P2)	; read Port B keyboard column
		XRI	#$FF		; invert
		JZ	L0374		; and return as key has been released
		CCL			; clear carry ready for addition
		LD	keywrd(P2)
		ADI	#$07		; add $07 to Keyword (7 keys in a Row)
		ST	keywrd(P2)
		JMP	L03B5		; and round again
;
L03CE:	XPPC	P3		; return from subroutine call
;
					; Serial Routine - Receive ?
L03CF:	CSA			; status to A
		ANI	#$20		; (AND with A) test SB (serial input)
		JNZ	L03CF		; wait for input low
L03D4:	CSA			; status to A
		ANI	#$20		; test SB
		JZ	L03D4		; and then wait for high transition
		LDI	#$60
		DLY	#$00		; delay 0.205mS (13+2*96)uS
		SIO			; shift SIN into E
		LDE			; copy E to A
		JMP	L03CE		; and return
;
L03E1:	XPPC	P3		; return from subroutine call
;
					; Serial Routine - Transmit ?
		LDI	#$01
		ANE			; A=A AND E, mask LS bit
		SIO			; and send to SOUT
		JZ	L03F5		; branch if bit was a zero
		LDI	#$38
		DLY	#$00		; delay 0.125mS (13+2*56)uS
		LDI	#$00
		XAE			; E=0
		SIO			; send a zero to SOUT
		XAE			; E=0
		LDI	#$4D
		DLY	#$00		; delay 0.167mS (13+2*77)uS
L03F5:	LDI	#$50
		DLY	#$00		; delay 0.173mS (13+2*80)uS
		XAE			; E=$FF
		SIO			; send a one to SOUT
		XAE			; E=$FF
		LDI	#$40
		JMP	L03E1		; and return