;
;		Acorn monitor for Acorn System 6809 CPU card
;
;		ISSUE 1 - V49 - FEB 1980
;
;		This program handles a memory mapped VDU, encoded keyboard,
;		cassette interface, parallel printer, and mini-floppy bootstrap.
;
;
; 2019-06-01	Source transcribed from Acorn 6809 User Manual by Keith Howell
; 2019-06-02	Ported for online assembler www.asm80.com
; 2019-07-04	Began changing to match program listing in manual looks a very
;		long job and the code differs in places
; 2019-09-21	Tweeked for Kingston 6809 assembler by J.G.Harston
;		Build with: as09-dos -i -h0 -m -n -w -lAcn6809.lst -oAcn6809.rom Acn6809.src
; 2019-09-25	Added options to build 80-column VDU and base memory+I/O in high memory
;		from Phill Harvey-Smith's recreated source.
;
; Differences:
;  Acorn assembler:                Kingston assembler:
;   Uses SETDP                      Uses DIRECT
;   Opcodes are valid as labels     Opcodes are invalid as labels
;                                   BSS marks data not to be saved
;                                   CODE marks data to be saved
;
; If using an assembler that does not use BSS and CODE, comment them out where
; they occur. If using an assembler that uses SETDP, comment out the SETDP macro.
;
; Define macros for assembers that don't have these instructions
SETDP	MACRO	dpvalue
	DIRECT	dpvalue
	ENDM
;
;
; This is the original Acorn 6809 card
VDU	EQU	40		; 40-column teletext VDU
BASE	EQU	$0000		; Base memory and I/O in low memory
;
; This is the Acorn 6809 card modified for Flex-compatible memory layout
;VDU	EQU	80		; 80-column text VDU
;BASE	EQU	$E000		; Base memory and I/O in high memory
; 
;
;
MPROM	EQU	$F800		 ; Normal monitor position at top of memory.
MONDP	EQU	(BASE+$0300)/256 ; Direct page for monitor.
;
ROWS	EQU	25			; Number of rows on display.
COLS	EQU	VDU			; Number of characters per row.
PSIZE	EQU	256*(VDU/10)		; Size of display memory in total.
PAGHI	EQU	12			; Page address register, high byte.
CURHI	EQU	14			; Cursor address register, high byte.
VPAGE	EQU	BASE+256*(VDU/10)	; Location of memory that VDU uses.
WRAPMSK	EQU	PSIZE/256-1		; Mask to wrap address within PSIZE.
	IF	VDU<80
CRTC	EQU	BASE+$0800		; Location of CRT controller on 40-column VDU card.
	ELSE
CRTC	EQU	BASE-(BASE/14)+$1840	; Location of CRT controller on 80-column VDU card.
	ENDIF
;
;
DRIVE	EQU	$40		; Drive to bootstrap from, other drive is $80.
FLOPY	EQU	BASE+$0A00	; Location of floppy disc controller.
FDCC	EQU	FLOPY+0		; Command register
FDCS	EQU	FDCC		; Status register.
FDCP	EQU	FLOPY+1		; Parameter register
FDCR	EQU	FDCP		; Result register.
FDRST	EQU	FLOPY+2		; Reset register.
FDCD	EQU	FLOPY+4		; Data register.
;
KVIA	EQU	BASE+$0980	; Location of versatile interface adaptor.
KORB	EQU	KVIA+$0		; Output register B.
KIRB	EQU	KORB		; Input register B.
KORA	EQU	KVIA+$1		; Output register A.
KIRA	EQU	KORA		; Input register A.
KDDRB	EQU	KVIA+$2		; Data direction register B.
KDDRA	EQU	KVIA+$3		; Data direction register A.
KT1CL	EQU	KVIA+$4		; Timer 1 counter low.
KT1CH	EQU	KVIA+$5		; Timer 1 counter high.
KT1LL	EQU	KVIA+$6		; Timer 1 latch low.
KT1LH	EQU	KVIA+$7		; Timer 1 latch high.
KT2CL	EQU	KVIA+$8		; Timer 2 counter low.
KT2CH	EQU	KVIA+$9		; Timer 2 counter high.
KSR	EQU	KVIA+$A		; Shift register.
KACR	EQU	KVIA+$B		; Auxiliary control register.
KPCR	EQU	KVIA+$C		; Peripheral control register.
KIFR	EQU	KVIA+$D		; Interrupt flag register.
KIER	EQU	KVIA+$E		; Interrupt enable register.
KORA2	EQU	KVIA+$F		; Input/output register A without hand shake.
;
INTDEL	EQU	15*256		; Delay for single instruction trace is 15 cycles.
T1IFLG	EQU	%01000000	; Interrupt flag position for timer 1.
CB1FLG	EQU	%00010000	; Interrupt flag position for keyboard strobe on CB1.
;
IKPCR	EQU	%11101111	; Initial value for peripheral control register,
				;  bit 0,    CA1 control from printer, positive edge interrupt,
				;            but not used in this monitor.
				;  bits 1-3, CA2 control to strobe printer, normally high.
				;  bit 4,    CB1 control, negative edge keyboard interrupt.
				;  bits 5-7, CB2 control, cassette output initially set high.
;
IKIER	EQU	%11010000	; Interrupt enable register control.
				;  bit 4, CB1 keyboard interrupt enable.
				;  bit 6, timer 1 interrupt enable.
				;  bit 7, set interrupts enabled.
				;  other enables not altered.
;
PSTRB	EQU	%00000010	; bit position in PCR of printer strobe, to toggle CA2
COPBIT	EQU	%00100000	; bit position in PCR of cassette output, to toggle CB2
;
SWIOP	EQU	$3F		; Software interrupt used for breakpoints.
;
BUFLEN	EQU	81+1		; Buffer up to 80 characters from keyboard.
;
PROMPT	EQU	"*"		; Monitor prompt character.
RUBCH	EQU	$7F		; Keyboard character that does rubout operation.
BSPACE	EQU	$7F		; Character that backspaces VDU, also used to do rubout.
LF	EQU	$0A		; Linefeed character.
CR	EQU	$0D		; Carriage return character.
SPACE	EQU	$20		; Blank space character.
COMMA	EQU	","		; A comma character.
MINUS	EQU	"-"		; A minus character.
FFEED	EQU	$0C		; Character used as clear screen command.
SEMIC	EQU	";"		; A semicolon.
;
IRQ	EQU	$10
ZERO	EQU	$04
;
;		Definitions of variables in page 3
;		----------------------------------
;
	BSS			; This data not saved to output file
	ORG	BASE+$035B
ISTACK	EQU	$		; $035B - Stack pointer starts here.
RTAB1	EQU	$		; $035B - RAM table 1 starts here.
;
;		This table copied from ROM on start-up
;
;				--- page 77 ---
;
STACK	RMB	2		; $035B - Position of stack pointer when empty
NTRACE	RMB	2		; $035D - Number of instructions to trace before stopping
BSECHO	RMB	1		; $035F - Character sent to backspace display
ECHOF	RMB	1		; $0360 - Keyboard buffer/echo control
				;  bits 0-5,	don't care
				;  bit 6	echo console input to console output if set
				;  bit 7	buffer input lines, allow rubout if set
;
PFLAG	RMB	1		; $0361 - Printer control flag, echo console output to printer if nonzero
PNEW	RMB	1		; $0362 - This character not sent to printer.
DELCNT	RMB	2		; $0363 - Non-zero delay count for cassette, controls baud rate.
COPADR	RMB	2		; $0365 - Address for console output.
CINADR	RMB	2		; $0367 - Address for console input.
CASOPA	RMB	2		; $0369 - Address for cassette output.
CASINA	RMB	2		; $036B - Address for cassette input.
PRINT1	RMB	2		; $036D - Address of printer output routine.
FUNCTI	RMB	2		; $036F - Address of VDU function table.
CMNDI	RMB	2		; $0371 - Address of monitor command table.
IRQRTS	RMB	2		; $0373 - Address to go to on timer 1 interrupt.
LINEPT	RMB	2		; $0375 - Address of memory input line, 0 if none.
IRESV	RMB	2		; $0377 - Address of reserved vector routine.
ISWI3	RMB	2		; $0379 - Address of SWI1 routine.
ISWI2	RMB	2		; $037B - Address of SWI2 routine.
IFIRQ	RMB	2		; $037D - Address of FIRQ routine.
IIRQ	RMB	2		; $037F - Address of IRQ routine.
ISWI	RMB	2		; $0381 - Address of SWI routine.
INMI	RMB	2		; $0383 - Address of NMI routine.
OFFSET	RMB	2		; $0385 - Cassette load offset
;
;		General variables for monitor use
;
HEADST	RMB	2		; $0387 - Static head pointer into line buffer
HEADDY	RMB	2		; $0389 - Dynamic head pointer into line buffer
TAIL	RMB	2		; $038B - Tail pointer into line buffer
MSTACK	RMB	2		; $038D - stack saved whilst memory interpreting
CROW	RMB	1		; $038F - current row of cursor on display
CCOL	RMB	1		; $0390 - current column of cursor on display
CPAGE	RMB	2		; $0391 - current start of display page in memory.
MSAV	RMB	2		; $0393 - Saved address for memory command.
GSAV	RMB	2		; $0395 - Saved address for go command.
NAME	RMB	6		; $0397 - Saved name for cassette input output.
CSSTRT	RMB	2		; $039D - Saved cassette output start address.
CSEND	RMB	2		; $039F - Saved cassette output end address
ONLINE	RMB	1		; $03A1 - flag set to zero when find or in input line.
LASTC	RMB	1		; $03A2 - Saved last character from input line current.
CBREAK	RMB	2		; $03A3 - Address of breakpoint, $FFFF if none
NBREAK	RMB	2		; $03A5 - number of breakpoints to ignore before stopping user
CINST	RMB	1		; $03A7 - user instruction at breakpoint address
CTRACE	RMB	2		; $03A8 - number of instructions left to trace before stopping user.
USRSTK	RMB	2		; $03AA - Saved user-stack pointer when user halted
TEMP	RMB	2		; $03AC - Temporary storage
BUFFER	RMB	BUFLEN		; $03AE - line input buffer
;				; $03FF - end of line input buffer
;
;		Memory map
;		----------
;	Acorn	Flex
;	$0000	$E000	Base memory
;	$0400	$E400	40-column Video memory
;	$0800	$E800	40-column 6845 CRTC
;		$E840	80-column 6445 CRTC
;	$0900	$E900
;	$0980	$E980	6522 VIA
;			 REGA   - b6-b0: printer output
;			          b7:    printer busy input
;			 REGB   - b6-b0: keyboard ASCII input
;			          b7:    cassette input
;			 CA1    - input from printer acknowledge (not used)
;			 CA2    - output strobe to printer
;			 CB1    - input strobe from keyboard
;			 CB2    - output to cassette
;			 Timer1 - used to single step
;			 Timer2 - unused
;	$0A00	$EA00	8271 floppy disk controller
;	$1000	$F000	80-column VDU memory
;	$1840	$E840	40-column 6845 CRTC
;	$F800	$F800	Monitor ROM
;
;
; 		Hardware reset starts at this address.
;
	CODE			; Code from here saved to output file
	ORG	MPROM
;	PUT	$E000
;
RESET:	LDA	#MONDP		; Set up
	TFR	A,DP		; direct page.
	SETDP	MONDP		; Tell assembler.
	LDX	#PTAB1		; ROM table start.
	LDU	#RTAB1		; RAM table start.
RST1:
	LDA	,X+		; Copy ROM
	STA	,U+		; to RAM
	CMPX	#PTAB2		; until end
	BNE	RST1		; of table.
	LDS	<STACK		; Set up stack pointer.
	LDX	MPROM-2
	CMPX	#$A55A		; Check for extra ROM,
	BNE	STRT1		; not there,
	JSR	[MPROM-4]	; else call it.
STRT1:
	LDU	#BACK		; Put monitor return
	PSHS	U		; onto stack.
	LDD	#12
STRT2:
	PSHS	A		; Put dummy registers
	DECB			; onto stack.
	BNE	STRT2
	STS	<USRSTK		; Save stack pointer.
	LDX	#BUFFER		; Get start of buffer
	STX	<HEADDY		; and set up pointers
	STX	<HEADST
	STX	<TAIL
	LBSR	CRTCI		; Initialise CRT controller
	LBSR	VIAI		; and VIA chips.
	CLR	<LASTC		; Set no saved character.
	LBSR	BRKOUT		; Remove if exists
	LDX	#$FFFF		; then set
	STX	<CBREAK		; non-existing.
	ANDCC	#$EF		; CLI: Allow interrupts.
;
	SETDP	0
MON:	LDA	#PROMPT		; Send prompt
	LDX	>LINEPT		; unless
	BNE	MON1		; memory input.
	LBSR	CONOUT		;

;			---- page 78 ----

MON1:	STA	>ONLINE		; Set no CR yet.
PARSE:
	LDA	#MONDP		;
	TFR	A,DP		; Set direct page
	SETDP	MONDP		; Tell assembler
	LDX	<LINEPT		; See if mem input,
	BEQ	PARSEC		; if so,
	LDA	,X		; then see if null yet
	BEQ	MEND		; End if is null.
PARSEC:	BSR	CONCHR		; Get input
	BEQ	MON		; prompt on CR
	LDX	<CMNDI		; else command table
	LBSR	DISPCH		; search.
	BRA	PARSE		;
;
; Enter here for monitor to use memory input line
; (X) is start of line, ends with a null.
; multiple input lines are allowed, each line ends
; with carriage return.
;
; Exits with (a) zero if all ok, else (a) is $FF
; if found null too early, else (a) is character
; causing error.

	SETDP	0
;
MEMUSE:	PSHS	DP
	STS	MSTACK		; Save stack for return.
	STX	LINEPT		; Save pointer in memory.
	CLR	LASTC		; Set none saved.
	BRA	MON		; and call monitor.
CONCHR:
	LDA	#CR		; Assume CR now
	TST	ONLINE		; and if found CR then
	BEQ	CON1		; is correct.
	BSR	CONIN		; Get input.
	CMPA	#CR		; If not CR then
	BNE	CON2		; done.
CON1:	CLR	ONLINE		; Set found CR
CON2:	RTS
;
; Console input routine, gets character from keyboard
; buffer or memory it finds null in memory then returns to
; to caller with error $FF.
;
	SETDP	MONDP
CONIN:	PSHS	DP,X
	LDA	#MONDP		; Set up
	TFR	A,DP		; direct page.
	LDA	<LASTC		; Saved one?
	BEQ	CON5		; none saved
	CLR	<LASTC		; not saved anymore
	PULS	DP,X,PC
;
CON5:
	LDX	<LINEPT		; see if mem input
	BEQ	CON3		; no, use buffer.
	LDA	,X+		; Get men value
	BNE	CON4		; ok if not null.
	DECA			; Set to $FF
MEND:
	LDS	<MSTACK		; clear mem
	CLR	<LINEPT+0	; input
	CLR	<LINEPT+1
	PULS	DP,PC		; and return to caller.
;
CON3:	JSR	[CINADR]	; Get console input
CON4:	STX	<LINEPT		; store new mem pointer
	PULS	DP,X,PC
;
; This routine prints the registers from the stack as pointed
; to by usrstk, then prints usrstk itself.
; also prints 5 bytes starting at (PC).
;
EXREG:	LDX	#TITLES		; Headings
	BSR	STRING		; printed first
	LDU	<USRSTK		;
	LDB	#$04		; ie, CC,A,B,DP.
EX1:
	LDA	,U+		; Get data
	LBSR	OPARSP		; output as 2 hex digits
	DECB			;
	BNE	EX1		; until all 4 output
	LDB	#$04		; ie, X, Y, U, PC
;
EX2:
	LDX	,U++		; get 2 bytes
	LBSR	OPXREG		; as 4 hex digits
	DECB			;
	BNE	EX2		; until all output
	LDX	<USRSTK		; then put out stack
	LBSR	OPXREG		; address.
	LDU	10,X		; Get user PC value.
	LDX	#PCMESS		; Send
	BSR	STRING		; title
	LDB	#$05		; then 5 bytes
EX3:
	LDA	,U+		;
	LBSR	OPARSP		;
	DECB			;
	BNE	EX3		;
;
; Output the string CR, LF to console

;			---- page 79 ----
;
OPCRLF:
	LDX	#SCRLF		; String address of CR, LF

; Output the string pointed to by (X) until a null,
; leaves X pointing to null+1, other registers intact.
;
STRING:
	PSHS	A		; Save A
STRNG1:
	LDA	,X+		; Get data
	BEQ	EOTXT		; finish if null
	LBSR	CONOUT		; else output
	BRA	STRNG1		; and repeat.
EOTXT:
	PULS	A,PC		; Get A back, and return.
;
; Calculate apparent address of cursor without
; allowing for memory wrap around, result in D.
;
CCOFST:
	LDA	#COLS		;
	LDB	<CROW		;
	MUL
	ADDB	<CCOL
	ADCA	#0
	ADDD	<CPAGE
	RTS
;
; Calculate real address of cursor in memory space,
; result returned in X.
;
CCLOCN:
	PSHS	D
	BSR	CCOFST		; Apparent address.
	ANDA	#WRAPMSK	; Wrap around in 1K or 2K page.
	ADDD	#VPAGE		; Add start of video page.
	TFR	D,X
	PULS	D,PC		; Unsave and return.
;
; Initialise versatile interface adapter.
;
VIAI:
	LDD	#(IKPCR*256)+IKIER
	LDX	#KVIA		; Point to VIA.
	STA	KPCR-KVIA,X	; Peripheral control register.
	STB	KIER-KVIA,X	; Interrupt enable register.
	LDA	#$7F		; Printer output (7 bits) plus
	STA	KDDRA-KVIA,X	; cassette input on a side.
	LDA	KIFR-KVIA,X	; Cancel any
	STA	KIFR-KVIA,X	; interrupts present.
	RTS
;
; Initialise CRT controller on VDU card, R or S version
;
CRTCI:	LDX	#CRTCSV			; Table for S version.
	LDD	#(((PAGHI+1)*256)+$AA)	; Test the page register
	STD	CRTC			; (low byte) for read/write
	CMPB	CRTC+1			; ability
	BEQ	CRTC11			; If so, then V version
	LEAX	<<(CRTCRV-CRTCSV),X	; else get R table instead.
CRTC11:	LDA	#12-1			; Set up 12 registers.
CRTC12:	LDB	A,X			; Get data
	STD	CRTC			; and store it in correct register.
	DECA				;
	BPL	CRTC12			; Repeat until all 12 done
;
; Reset display to a blank page with cursor
; at top left of screen
;
CLRALL:	CLR	<CROW		; Row 0.
	CLR	<CCOL		; Column 0.
	CLR	<CPAGE+0	; Current page set
	CLR	<CPAGE+1	; to start of display memory.
	LBSR	SETTOP		; Set page in CRTC chip
	LBSR	SETCUR		; and set cursor in CRTC chip
;
; Clear the display memory to all blanks.
;
CLRSCN:	LDD	#(SPACE*256+SPACE) ; Two spaces
	LDX	#VPAGE		; Start of display memory.
CLRS1:	STD	,X++		; Store two blanks
	CMPX	#VPAGE+PSIZE	; and repeat
	BNE	CLRS1		; until done all page.
	RTS
;
; This routine used to put a character to the VDU,
; handling CR, LF, backspace, and form feed.
; all registers are saved.
;
DISPLA:
	PSHS	U,Y,X,DP,B,A,CC	; Save registers.
	LDB	#MONDP
	TFR	B,DP		;
	LDX	<FUNCTI		; Get function table.
	ORCC	#IRQ		; Stop interrupts since not re-entrant.
	BSR	DISPCH		; Jump on function table
	PULS	U,Y,X,DP,B,A,CC,PC	; then restore and return.
;
; This routine puts a character on display and moves cursor.
;
SIMCHR:	BSR	CCLOCN		; Find location in memory
	STA	,X		; and store character
	INC	<CCOL		; move cursor across
	LDA	<CCOL		; then done if

;				---- page 80 ----

	CMPA	#COLS		; all columns
	BNE	SIM1		; not yet filled.
	CLR	<CCOL		; Do CR.
;
; Move cursor down 1 line, scroll display if required.
;
DOLF:	INC	<CROW		; Down a row.
	LDA	<CROW		;
	CMPA	#ROWS		; Last row yet
	BNE	SIM1		; if not then done,
	DEC	<CROW		; else back up
	BSR	SCROLL		; and scroll instead
SIM1:	BRA	SETCUR		; then set new cursor.
;
; Move cursor back erasing last character.
;
DORUB:	BSR	BSONE		; Back up cursor
	LDA	#SPACE		;
	BSR	DISPLA		; then blank last character,
	BSR	BSONE		; and back up again
LF98D:	BRA	SETCUR		; then set cursor up.
;
; Back cursor up allowing line and row underflow.
;
BSONE:	DEC	<CCOL		; Left move cursor.
	BPL	BS1		; No under flow
	LDA	#COLS-1		; else set to
	STA	<CCOL		; right margin
	DEC	<CROW		; and up one row.
	BPL	BS1		; No row underflow.
	CLR	<CROW		;
	CLR	<CCOL		;
BS1:	RTS
;
; Dispatch routine looks up a character in a table,
; character in A, table address ???) X.
;
; Table format is:
;   First byte, number of entries 1 to 255
;   Repeat for each entry: character to match with,
;                          2 byte offset from start of this
;                          table of routine to jump to if
;                          characters match.
;
;     flag byte:  control if no match found:
;                 positive: next word is offset of default routine
;                 zero:     return to calling program
;                 negative: next word is address of another table to search.
;
DIS2:	LDD	,X		; Get address of new table,
	STD	2,S		; replace old on stack,
	PULS	D,X,U		; and begin again.
DISPCH:	PSHS	D,X,U		; Save registers.
	LDB	,X++		; Get length and move to offset.
DIS1:	CMPA	-1,X		; Compare characters.
	BEQ	DIS3		; Found it, else,
	LEAX	3,X		; move down.
	DECB			; Repeat until
	BNE	DIS1		; done.
	TST	-1,X		; Test flag byte.
	BEQ	DIS4		; Zero means return
	BMI	DIS2		;  search new table, else
DIS3:	LDD	,X		; get offset and
	ADDD	2,S		; add start of table, then
	STD	4,S		; store in stack.
	PULS	D,X,PC		; Restore and go to routine.
DIS4:	PULS	D,X,U,PC	; Return to caller.
;
; Scroll the display up one line, leave cursor at same
; position on screen, leave registers intact.
;
SCROLL:	LDD	<CPAGE		; Get start of page
	ADDD	#ROWS*COLS	; then move off end.
	LDX	#VPAGE		; Actual memory address.
	LDU	#SPACE*256+SPACE	; Double space.
	LDY	#COLS/2		; Number to blank.
SCR1:	ANDA	#WRAPMSK	; Wrap around in 1K or 2K
	STU	D,X		; and put 2 blanks.
	ADDD	#2		; Move up and
	LEAY	-1,Y		; repeat until
	BNE	SCR1		; line done.
	SUBD	#ROWS*COLS	; Move to second line now
	ANDA	#WRAPMSK	; wrap around and
	STD	<CPAGE		; set as new page.
	BSR	SETCUR		; Put cursor back in position.
;
; Put page address into CRT controller.
;
SETTOP:	LDX	<CPAGE		; Get page
	LDA	#PAGHI		; Point to page start register
	BRA	SETPAR		; then enter parameters.
;
; Do a carriage return by setting column to 0.
;
DOCR:	CLR	<CCOL

;			---- page 81 ----

;
; Set cursor register in CRT controller.
;
SETCUR:	LBSR	CCOFST		; Get cursor address, no wrap around
	TFR	D,X		; into X.
	LDA	#CURHI		; Point to cursor register.
;
; Put 2 byte value into CRT controller, value in X,
; high byte register number in A.
;
SETPAR:	PSHS	X		; Get high byte.
	PULS	B		; Set register
	STD	CRTC		; and data move to low byte.
	INCA			; Get low byte.
	PULS	B		; Set register
	STD	CRTC		; and data.
	RTS
;
; This routine puts keyboard input into line buffer.
; If no room then ignores character, else echoes to display.
; If echo is switched on handles rubout unless line buffer
; is switched off.
;
HAVCHR:	LDB	<ECHOF
	BPL	HAV3		; Buffer off, so no rubout.
	CMPA	#RUBCH
	BEQ	BSP1		; Go do rubout.
HAV3:	BSR	PUTCHR		; Put into buffer.
	BEQ	PUT1		; No room, do not echo.
	TSTB			; If buffer off, then no
	BPL	HAV4		; line feed on CR input.
	CMPA	#CR		;
	BNE	KBECHO		; Not CR, so no
	BSR	KBECHO		; echo of a line
	LDA	#LF		; feed.
HAV4:	STX	<HEADST		; Move static pointer up.
;
; Put character in A to console output if echo on.
;
KBECHO:	LDB	<ECHOF		; See if echo on.
;	ASLB			; Need bit 6.
	LSLB			; Need bit 6.
	BPL	PUT1		; Not on if zero.
;
; Console output routine, sends to printer also
; if switched on.
;
	SETDP	0
CONOUT:	TST	PFLAG		; If printer off then
	BEQ	CANOP1		; value is zero
	JSR	[PRINT1]	; else call printer
CANOP1:	JMP	[COPADR]	; then console output
;
	SETDP	MONDP
BSP1:	LDX	<HEADDY		; End of line, if at
	CMPX	<HEADST		; start of line
	BEQ	PUT1		; then nothing to rubout.
	CMPX	#BUFFER		; Do cyclic
	BNE	BSP2		;
	LEAX	BUFLEN,x	; decrement of pointer.
BSP2:	LEAX	-1,x		;
	STX	<HEADDY		; Set new end of line
	LDA	<BSECHO		; and echo a backspace.
	BRA	KBECHO		;
;
; Put character into buffer if room, return z=0,
; else return z=1.
;
PUTCHR:	LDX	<HEADDY		; Get pointer.
	BSR	BUMPU		; If no room, then
	CMPX	<TAIL		; pointers equal,
	BEQ	PUT1		; so done.
	STA	,X		; Store it and
	STX	<HEADDY		; set new pointer.
	ANDCC	#255-ZERO	; Clear Z flag
PUT1:	RTS
;
; Cyclic increment of buffer pointers.
;
BUMPU:	LEAX	1,X
	CMPX	#BUFFER+BUFLEN	;
	BNE	ANRTS		;
	LDX	#BUFFER		;
ANRTS:	RTS			;
;
; Get character from buffer, if none then clears interrupt
; mask and waits. all registers saved, including CC.
;
	SETDP	0
GETCHR:	PSHS	X,CC		; Save and
	BRA	GETCH1		; skip wait.
GETCH2:	CWAI	#(255-IRQ)	; Wait for an interrupt.
GETCH1:	LDX	TAIL		; Get tail pointer.
	CMPX	HEADST		; If equals static head
	BEQ	GETCH2		; then no character
	BSR	BUMPU		; else move up
	LDA	,X		; and get it.
	STX	TAIL		; Set new tail.
	PULS	CC,X,PC

;			---- page 82 ----

;
; Output X register as 4 hex digits to console,
; all registers saved.
;
	SETDP	MONDP
OPXREG:	PSHS	D
	TFR	X,D		;
	BSR	OPAREG		;
	TFR	B,A		;
	BSR	OPARSP		;
	PULS	D,PC		;

; Output 'a' register as 2 hex digits to console,
; all registers saved except a.
;
OPAREG:	PSHS	A
	LSRA			;
	LSRA			;
	LSRA			;
	LSRA			;
	BSR	HEXOUT		; Left nibble.
	LDA	,S+		; Get byte back and
	ANDA	#15		; do right nibble
;
; Output a as a single hex digit.
;
HEXOUT:	ADDA	#"0"		;
	CMPA	#"9"		;
	BLS	HEX2		;
	ADDA	#"A"-"9"-1	;
HEX2:	BRA	CONOUT		; Output and return.
;
; Output a hex digit folowed by a space
;
OPARSP:	BSR	OPAREG		;
	LDA	#SPACE		;
	BRA	HEX2		;
;
; Printer routine, this interfaces to anadex or centronics
; parallel interface printers.
;
	SETDP	0
PRINT:	PSHS	D,U
	LDU	#KVIA		; Point to VIA.
	CMPA	PNEW		; If spec'd symbol then
	BEQ	PEXIT		; do not send.
PWAIT1:	LDB	KORA2-KVIA,U	; Check if busy.
	BMI	PWAIT1		; If so then wait.
	STA	KORA-KVIA,U	; Store data
	LDB	#IKPCR-PSTRB	; then low strobe
	STB	KPCR-KVIA,U	
	LDB	#IKPCR		; and high
	STB	KPCR-KVIA,U	; strobe.
PEXIT:	PULS	PC,U,B,A	; Pull registers and return

; These tables are the decision tables for the memory examine and change function.
	SETDP	MONDP
MTABA:	DB	(MTABAE-MTABA)/3-1	; number of entries.
	DB	"V"
	DW	VADDR-MTABA		; Modify break address and memory.
	DB	"G"
	DW	GADDR-MTABA		; Modify go address and memory.
	DB	"P"
	DW	PADDR-MTABA		; Modify proceed address and memory.
	DB	"R"
	DW	RADDR-MTABA		; Modify register locations.
	DB	SPACE
	DW	SPACEA-MTABA
	DB	COMMA
	DW	COMMAA-MTABA
	DB	SEMIC
	DW	SEMICA-MTABA
	DB	MINUS
	DW	MINUSA-MTABA
	DB	1
	DW	NOTA-MTABA
MTABAE	EQU $
;
MTABB:	DB	(MTABBE-MTABB)/3-1
	DB	SPACE
	DW	SPACEB-MTABB
	DB	COMMA
	DW	COMMAB-MTABB
	DB	SEMIC
	DW	SEMICB-MTABB
	DB	MINUS
	DW	MINUSB-MTABB
	DB	1
	DW	NOTB-MTABB
MTABBE	EQU $

;			---- page 83 ----

;
; Memory examine and change routine.
;
VADDR:	LBSR	BRKOUT		; Take out any break.
	LDU	#CBREAK		; point to break address store
	BRA	ADDR1
GADDR:	LDU	#GSAV		; point to go address store.

ADDR1:	LDY	,U		; Get initial value.
	BRA	GDATA
PADDR:	LDU	<USRSTK
	LEAU	10,U		; Point to user PC.
	BRA	ADDR1
RADDR:	LDY	<USRSTK		; Get address off 'CC' register.
RADDR1:	LDU	#TEMP		; Dummy location for new value.
	BRA	GDATA
;
MEM:	LDU	#MSAV		; Point to memory address store.
	LDY	,U		; Get initial value.
	CLRB			; Set status zero.
SPACEA:	LBSR	CONCHR		; Get input.
	BEQ CRA			; No address given.
	LDX	#MTABA		; Search address
	LBRA	DISPCH		; table.
;
CRD:	TSTB			; If status
	BLE	CRA		; -1 or 0 then no change
	LEAY	1,Y		; else up one.
;
CRA:	TFR	Y,X		; Print out
	LBSR	OPXREG		; address
	LDA	,X		; then
	LBSR	OPARSP		; data.
	LDB	#1		; Set status +1.
	STB	<ONLINE		; Allow next line
	BRA	GDATA		; and continue.
;
NOTA:	STA	<LASTC		; Save for re-use.
	BSR	NUMB		; Get number with
	BVS	MERR		; error if none
	TFR	D,Y		; is new address.
DAT1:	CLRB			; Set status 0.
COMMAA:	EQU	$
SPACEB:	EQU	$
GDATA:	LBSR	CONCHR		; Get input.
	BEQ	CRD		; No data found CR
	LDX	#MTABAE		; else search
	LBRA	DISPCH		; data table.
;
SEMICB:	TSTB			; Test status.
	BGE	SEMICA		; If -1 then
	LEAY	-1,Y		; dec before.
SEMICA:	STY	,U		; Save new address
	RTS			; and exit.
;
MINUSA	EQU	$
MINUSB:	LEAY	-1,Y		; Back down 1,
	TSTB			; but if status
	BGE	MIND2		; is -1 then
	LEAY	-1,Y		; duck down 2
MIND2:	BRA	DAT1		; then continue.
;
NOTB:	STA	<LASTC		; Save for re-use
	BSR	NUMB		; in number.
	BVS	MERR		; Should have number.
	STB	,Y		; Store data then
	CMPB	,Y		; check it
	BEQ	COMMAB		; is ok,
	LDX	#MQRY		; else tell
	LBSR	STRING		; user.
COMMAB:	LEAY	1,Y		; Go up 1
	LDB	#$FF		; with status -1
	BRA	GDATA		; then continue.
;
MERR:	LBSR	CONCHR		; Get wrong symbol
	LBRA	BADCMD		; and tell user.
;
; Get hex number from input stream allow leading spaces,
; and stop on first non-hex character return number in D,
; with V=0, if no number then do and V=1.
;
; LFBA5
	SETDP	0
NUMB:	CLRA
	CLRB			;
	PSHS	D		; Put initial zero value.
	BSR	GETHXS		; Get first non-blank as hex value
	BVS	NUMB1		; wasn't hex.
NUMB3:	LDB	#$04		;
	ASLA			; Move to
	ASLA			;
	ASLA			;
	ASLA			; high nibble.
NUMB2:	ASLA			; Rotate into
	ROL	1,S		;
	ROL	0,S		; value
	DECB			; Do 4 times.
	BNE	NUMB2		; Get a hex digit from console.
	BSR	GETHEX		; Was hex so use,
	BVC	NUMB3		; else finish with V clear.
NUMB4:	ANDCC	#$FD		; CLV
NUMB1:	PULS	D,PC
;
; gethxs - get a hex digit ignoring leading spaces.
; gethex - get a hex digit both return value in A, with V=0, else set V=1 if non-hex.
;
GETHXS:	LBSR	CONCHR		; Get input.
	BEQ	GETH5		; On CR, no number.
	CMPA	#SPACE		; If space
	BEQ	GETHXS		; then ignore.
	BRA	GETH2		; Change to hex.

GETHEX:	LBSR	CONCHR		; Get input.
	BEQ	GETH5		; On CR, no number.
GETH2:	CMPA	#"0"		;
	BCS	GETH1		; Illegal hex.
	CMPA	#"9"		;
	BLS	GETH3		; Number hex.
	CMPA	#"A"		;
	BCS	GETH1		; Illegal hex.
	CMPA	#"F"		;
	BLS	GETH4		; Alpha hex.
GETH1:	CMPA	#COMMA		;
	BEQ	GETH5		; Absorb comma.
	STA	LASTC		; else re-use.
GETH5:	ORCC	#$02		; Bad hex, SEV
	RTS
;
GETH4:	SUBA	#7		; Alpha offset.
GETH3:	SUBA	#"0"		; Number offset
	RTS			; with V clear.
;
; Resume user program using stack as stands
;
	SETDP MONDP
RESUME:	LEAS	2,S		; Strip return address.
	BSR	NUMB		; Get number or zero
	STD	<NBREAK		; and set break ignore count
RES2:	BSR	BRKIN		; Insert breakpoints
	PULS	PC,U,Y,X,DP,B,A,CC	; and pull all user registers off stack
;
; Software interrupt handler, come here on breakpoint.
; Either stops and displays registers or traces past
; breakpoint and resumes.
;
SWIHAN:	LDA	#MONDP		; Set up
	TFR	A,DP		; direct page.
	SETDP	MONDP		; Tell assembler
	LDX	10,S		; back up
	LEAX	-1,X		; user
	STX	10,S		; program counter
	BSR	BRKOUT		; remove breakpoint.
	LDX	<NBREAK		; Get count.
	BEQ	RES1		; stop if zero, else
	LEAX	-1,X		; decrement
	STX	<NBREAK		; and restore.
	BSR	TUSER1		; Trace past break
	BRA	RES2		; then resume again
RES1:	STS	<USRSTK		;
	LBSR	EXREG		; display registers
	BRA	BACK1		; and stay in monitor
;
; Change number in X if one given in input stream,
; destroys D.
;
NUMBX:	BSR	NUMB
	BVS	NUMBX1		; No number.
	TFR	D,X
NUMBX1:	RTS
;
; User program returns here if RTS done.
;
BACK:	LEAS	-2,S		; Make room for new return address
	PSHS	CC,A,B,DP,X,Y,U,PC	; and save all user registers.
	LDX	#BACK		; Set return address
	STX	12,S		; again
	LDB	#MONDP		;
	TFR	B,DP		;
	BSR	BRKOUT		; Remove breakpoints.
	STS	<USRSTK		; Save user stack pointer
BACK1:	ANDCC	#$EF		; CLI: enable interrupts
	LBRA	PARSE		; and resume monitor functions.
;
; Go to user program, optional address specified.
; The stack pointer is reset, but the register contents
; are maintained as listed by the command.
;
GOUSER:	CLR	<NBREAK+0	; Put zero in
	CLR	<NBREAK+1	; break count.
	LDU	<ISTACK		; Get pointer
	LDX	#BACK		; return address,
	STX	,--U		; pushed first
	LDB	#11+2		; 12 registers plus return.
GO1:	LDA	B,S		; Get value and
	STA	,-U		; push it

;			---- page 85 ----

	DECB			;
	BPL	GO1		; For all registers
	LEAS	2,U		; new stack, ignore return address.
	LDX	<GSAV		; Saved address.
	BSR	NUMBX		; Change if given
	STX	<GSAV		; and restore.
	STX	10,S		; Put as user PC.
	BSR	BRKIN		; Insert breakpoint
	PULS	CC,A,B,DP,X,Y,U,PC	; and begin user program.
;
; Change user breakpoint position.
;
BRKSET:	BSR	BRKOUT		; Ensure old is out
	LDX	#$FFFF		; value for no break.
	BSR	NUMBX		; change if given
	STX	<CBREAK		; and save.
	RTS			;
;
; Put breakpoint in if one exists.
;
BRKIN:	BSR	BRKTST		; See if exists.
	BEQ	BRK1		; Already a SWI, so done
	STA	<CINST		; else save it
	LDA	#SWIOP
	STA	,X		; and insert a SWI instead.
BRK1:	RTS
;
; Check break required, if not does RTS twice.
;
BRKTST:	LDX	<CBREAK		; Get address
	CMPX	#$FFFF		; $FFFF means none
	BEQ	BRK10		; not one.
	LDA	,X		; Get instruction
	CMPA	#SWIOP		; see if SWI
	RTS			; then exit.
BRK10:	PULS	PC,X		; Exit twice
;
; Called by SWI
; -------------
; Remove a breakpoint if one present in code.
;
BRKOUT:	BSR	BRKTST		; See if exists.
	BNE	BRK2		; Not SWI, leave alone.
	LDA	<CINST		; Get saved instruction
	STA	,X		; and restore in code.
BRK2:	RTS
;
; Trace one instruction of user code.
;				;
TUSER1:	PULS	X		; Get return address
	STX	<IRQRTS		; and save it
	LDA	#(255-IRQ)	; Clear IRQ mask
	ANDA	,S		; in user
	STA	,S		; condition codes.
	LDD	#INTDEL		; Delay before interrupt.
	STD	KT1CL		; Set timer going,
	PULS	CC,A,B,DP,X,Y,U,PC	; start user program running.
;
; Set number of instructions to trace on each command.
;
TRACEN:	LBSR	NUMB		; Get 0 if no number.
	STD	<NTRACE		; Save result.
TRACE1:	RTS
;
; Trace required number of instructions then display
; register contents and halt user.
;
TRACE:	LDX	<NTRACE		; Get number to trace.
	BEQ	TRACE1		; ignore command if zero.
	LEAS	2,S		; strip return address.
TRACE2:	STX	<CTRACE		; save number left.
	BSR	TUSER1		; trace one instruction.
	LDX	<CTRACE		; Get number left
	LEAX	-1,X		; and decrement.
	BNE	TRACE2		; repeat if required
	LBRA	RES1		; else show registers and halt user.
;
; Turn printer echo of console output on or off.
;
PCNTL:	LBSR	CONCHR		; Get input
	BEQ	POFF		; if CR then off
	CMPA	#"+"		; if plus
	BEQ	PON		; then switch on.
	STA	<LASTC		; Re-use if not +.
POFF:	CLRA			; Switch off value.
PON:	STA	<PFLAG		; Set flag.
	RTS
;
; If get bad command, query it and ignore rest of line.
;
BADCMD:	LDX	<LINEPT		; If memory input
	LBNE	MEND		; then exit.
	LDX	#CQRY		; Output query
	LBSR	STRING		; message
	LBSR	CONOUT		; and character
	LBSR	OPCRLF		; followed by CR, LF.
BAD1:	LBSR	CONCHR		; Get input and
	BNE	BAD1		; if not CR then ignore it
	RTS			; then carry on.

;			---- page 86 ----

;
; Cassette file load routine, this searches for named file
; followed by data.
;
LOAD:	LBSR	NAMEIN		; Get file name.
	LBSR	NUMB		; Get offset
	STD	<OFFSET		; and save.
LOAD2:	LDX	#NAME		; Point to filename space
LOAD4:	LDA	#"0"		; Get name file
	BSR	GETHDR		; header.
	BNE	LOAD4		; Ignore others.
	LDB	#$06		; Name length.
	STB	<TEMP		; Save it.
LOAD3:	BSR	CBIN1		; Get input character
	LDB	,X+		; and name character.
	CMPB	#"?"		; If wildcard
	BEQ	LOAD1		; then matches
	CMPA	-1,X		; else compare.
	BNE	LOAD2		; Wrong name.
LOAD1:	DEC	<TEMP		; Count name length.
	BNE	LOAD3		; Repeat for all 6.
	BSR	CBIN1		; Ignore checksum byte.
;
; Enter here for match without file name check.
;
LOAD7:	LDA	#"1"		; Get data
	BSR	GETHDR		; header.
	BNE	LOAD5		; Wrong header.
	BSR	CBIN2		; Get start address
	TFR	D,X		; and save while
	BSR	CBIN2		; getting end address.
	PSHS	D		; Put end on stack.
LOAD6:	BSR	CBIN1		; Get data item
	STA	,X+		; and store it
	CMPX	,S		; if not done
	BLS	LOAD6		; then repeat.
	BSR	CBIN1		; Get checksum byte.
	PULS	X		; Get old end address.
	LBSR	OPXREG		; Show address so far
	TFR	U,D		; check summed in U
	COMB			; lower byte only.
	BEQ	LOAD7		; If ok, then repeat
LFCEA:	LDX	#LQRY		; else message
	LBSR	STRING		; output.
	BRA	LKEYON		;
;
LOAD5:	CMPA	#"9"		; if not '9' then
	BNE	LOAD7		; ignore.
LKEYON:	LDA	#CB1FLG+$80	; Turn on
	STA	KIER		; keyboard
	LBRA	OPCRLF		; then exit.

; Get a header from the tape, if the expected one
; then set zero status, else return non-zero status.
; Initialises the checksum in U to 0.

GETHDR:	PSHS	A		; Save character.
	LDA	#CB1FLG		; Turn off
	STA	KIER		; keyboard.
GETHD1:	BSR	CBIN1		; Get from tape
	CMPA	#"X"+$80	; and if not 'X' header marker
	BNE	GETHD1		; then try again.
	BSR	CBIN1		; Get next character.
	LDU	#$0		; Set up checksum
	CMPA	,S+		; and compare with required
	RTS			; then return.
;
; Get 2 bytes and form a 16-bit value in D.
; Add offset since is address.
;
CBIN2:	BSR	CBIN1		; Get 1 byte
	TFR	A,B		; and save while
	BSR	CBIN1		; get second.
	EXG	A,B		; Wrong order, swap over.
	ADDD	<OFFSET		; Move by offset.
	RTS
;
; Get 1 byte from tape, modifying checksum to suit.
;
CBIN1:	JSR	[CASINA]	; Get byte then
	LEAU	A,U		; add to checksum.
	RTS
;
; Software asynchronous transmitter, outputs value in A
; as a start bit, 8 data bits, 2 stop bits, at rate controlled
; by count in delcnt
;
MCASOP:	PSHS	CC,D,X		; Saves all registers
	ORCC	#$50		; SEIF, Keep timing.
	LDB	#11		; Total length.
	PSHS	B		; Save on stack.
	LDB	#IKPCR-COPBIT	; Low start bit.
	COMA			; Want data inverted.
MCAS01:	NOP			; Get timing
LFD31:	BRA	MCAS02		; constant.

;			---- page 87 ----

MCAS02:	DEC	,S		; Bits counter.
	BMI	MCAS03		; All done.
	STB	KPCR		; Put out, but
	BSR	CWAIT		; wait 1 bit time.
	ANDB	#255-COPBIT	; Assume next is zero.
	LSRA			; Get next bit.
	BCS	MCAS01		; Do want zero
	ORB	#COPBIT		; else set bit
	BRA	MCAS02		; and loop round.
MCAS03:	LEAS	1,S		; Remove counter.
	PULS	CC,D,X,PC	; and return.
;
; cwait waits for 1 bit time, destroys X.
; hwait waits 1/2 bit time, also destroys X.
;
	SETDP	0
CWAIT:	BSR	HWAIT		; Do first half.
HWAIT:	LDX	DELCNT		; Get count required.
HW1:	LEAX	-1,X		; Decrement
	BNE	HW1		; while non-zero.
	RTS
;
; Software asynchronous receiver, gets value into A.
; Saves all other registers, only gets 1 stop bit.
;
	SETDP	MONDP
MCASIN:	PSHS	B,X
	LDA	#$80		; Rotating counter.
MCAS11:	LDB	KIRB		; Wait for
LFD5A:	BMI	MCAS11		; start bit.
	BSR	HWAIT		; Wait 1/2 bit time.
	LDB	KIRB		; Recheck
	BMI	MCAS11		; start bit.
MCAS12:	BSR	CWAIT		; Wait whole bit time
	LDB	KIRB		; and get input
	CMPX	,S		; waste time to
	CMPS	,S		; match loop delays.
	LSLB			; Move bit to carry
	RORA			; then into byte.
	BCC	MCAS12		; Repeat for 8 bits.
	BSR	CWAIT		; Get into stop bit
	PULS	B,X,PC		; and done.
;
; Routine gets name from input stream, up to 6
; characters long. No name leaves memory unaltered.
; Any name is padded to 6 characters with spaces.
;
NAMEIN:	LDX	#NAME+6
NAM2:	LBSR	CONCHR		; Get a character
	BEQ	NAM1		; no name
	CMPA	#SPACE		; if space
	BEQ	NAM2		; ignore.
	CMPA	#COMMA		;
	BEQ	NAM1		; Null name.
	LDB	#256-6		; Minus name length.
NAM3:	STA	B,X		; Store a letter
	INCB			; and move up.
	BEQ	NAM6		; Done 6 chars, exit.
	LBSR	CONCHR		; Get next letter.
	BEQ	NAM5		; On CR, pad name.
	CMPA	#SPACE		; On space,
	BEQ	NAM4		; pad name.
	CMPA	#COMMA		; If not comma
	BNE	NAM3		; then use
NAM5:	LDA	#SPACE		; padding.
NAM4:	STA	B,X		; Pad until
	INCB			; end of
	BNE	NAM4		; name buffer.
NAM1:	RTS
NAM6:	LBSR	CONCHR		; Get next input
	BEQ	NAM1		; leave if CR.
	CMPA	#COMMA		; else
LFDA8:	BEQ	NAM1		; absorb comma
	STA	<LASTC		; else re-use.
	RTS
;
; Save files on cassette, dumps name block, data blocks
; as required in 256 byte blocks maximum, then end file block.
; Can also inhibit end of file block.
;
SAVE:	LDX	<CSSTRT		; Modify start address
	LBSR	NUMBX		; if
	STX	<CSSTRT		; required.
	LDX	<CSEND		; Modify end address
	LBSR	NUMBX		; if
	STX	<CSEND		; required
	BSR	NAMEIN		; and get name.
	LDB	#"0"		; Output name,
	BSR	XHEAD		; header.
	LDB	#6		; name length.
	leax	-6,X		; Point to name,
	BSR	DATOUT		; output name,
	BSR	CHKOUT		; then checksum.
	LDX	<CSSTRT		; Get start address.
SAV6:	PSHS	X		; Save start
	LDD	<CSEND		; and get end address.

;			---- page 88 ----

	SUBD	,S++		; Form length needed.
	BLO	SAV2		; Done all output.
	TSTA			; If <=256 then
	BEQ	SAV5		; leave alone
	LDD	#255		; also set to 256.
SAV5:	LEAU	D,X		; Form end of block.
	PSHS	D,X,U		; Put start/end on stack.
	LDB	#"1"		; Put a data
	BSR	XHEAD		; header.
	LEAX	2,S		; Point to start/end.
	LDB	#4		; Two words
	BSR	DATOUT		; and put start/end out.
	PULS	D,X,U		; Get all back.
	INCB			; Modify length.
	BSR	DATOUT		; and send data bytes
	BSR	CHKOUT		; then checksum
	BRA	SAV6		; and repeat.
;
SAV2:	LBSR	CONCHR		; Get input.
	BEQ	SAV3		; On CR send of block.
	CMPA	#"-"		; If EOF inhibit
	BEQ	RTS1		; then skip x9.
	STA	<LASTC		; Re-use input.
SAV3:	LDB	#"9"		; Send EOF.
;
; Routine to send header to block, header type in B.
; Also initialises checksum in Y.
;
XHEAD:	LDY	#0
XH1:	LEAY	-1,Y		; Loop
	BNE	XH1		; delay.
	LDA	#("X"+$80)	; Send an 'X' header marker
	BSR	CASOPI		; to cassette.
	TFR	B,A		; Get type
	BRA	CASOPI		; and send.
;
; Data output routine, sends B databytes starting from X
; (B zero means 256 bytes), X moves up by B bytes.
;
DATOUT:	LDA	,X+		; Get data.
	LEAY	A,Y		; Modify checksum.
	BSR	CASOPI		; Send data.
	DECB			; Repeat until
	BNE	DATOUT		; zero count.
RTS1:	RTS
;
; Send checksum to tape from Y, lower byte only.
;
CHKOUT:	TFR Y,D			; Checksum to D
	TFR B,A			; then get low byte.
	COMA			; Want result $FF.
CASOPI:	JMP	[CASOPA]	; Send check byte.
;
; Drive parameter specification.
;
DISCIT:
; Set up drive.
	DB	$35,4,$0D,$14,$05,$AA		; For Shugart drive.
; Drive bad tracks.
	DB	$35,4,(((DRIVE/$80)*8)+$10),$FF,$FF,$FF
; Mode register setup
	DB	$3A+DRIVE,2,$17,$C1
; Load head onto disc, starts motor.
	DB	$3A+DRIVE,2,$23,$28+DRIVE
; Query drive ready.
	DB	$2C+DRIVE,0
; Seek to track 0.
	DB	$29+DRIVE,1,0
; Query drive ready.
	DB	$2C+DRIVE,0
; Read sector 2.
	DB	$13+DRIVE,3,$00,$02,$21
; Read starting at sector 3.
	DB	$13+DRIVE,2,$00,$03

;			---- page 89 ----

;
; This routine bootstraps from a mini-floppy disc.
; Reads sector 2 to find where to put program.
;
BOOT:	LDX	#ANRTI		; Set dummy
	STX	<INMI		; interrupt routine.
	LDA	#FLOPY/256	; Set direct page
	TFR	A,DP		; to floppy controller
	SETDP	FLOPY/256	; and tell assembler
	LDX	#DISCIT		; Point to tables.
	BSR	CMDPAR		; Set drive parameters.
	BSR	CMDPAR		; Set bad tracks.
	BSR	CMDPAR		; Set mode register.
	BSR	CMDPAR		; Load head, drive on.
	BSR	DRVRDY		; Check drive ready.
	BSR	CMDPAR		; Seek track 0
	BSR	DRVRDY		; Check drive ready.
	BSR	CMDPAR		; Read sector 2.
	LDU	#(BASE & $C000)	; Put at $0000 or $C000
	TFR	U,Y		; and point to it.
	BSR	TRNSFR		; Move disc data to memory.
LFE67:	BNE	DERR		; Non-zero means error.
	LDD	#$FF42		; Check first two bytes
	CMPD	,Y++		; are $FF42
	BNE	DERR		; If not $FF42, no boot present.
	BSR	CMDPAR		; Start read at sector 3.
	LDU	,Y++		; Get address to put at
	LDA	,Y+		; and number of sectors.
	LDY	,Y		; Start of program.
	ADDA	#$20		; Add sector length value.
BOOT1:	LDB	<FDCS		; Get FDC status and
	BITB	#$20		; if parameter register full
	BNE	BOOT1		; then wait.
	STA	<FDCP		; Send number of sectors.
	BSR	TRNSFR		; Move data to memory.
	BNE	DERR		; Error if non-zero.
	LBSR	NUMB		; Try get number.
	BVC	RTS2		; Got one, stay in monitor.
	LDS	STACK		; Reset stack and
	JMP	,Y		; go to program.
DERR:	LDX	#DQRY		; Query user
	LBSR	STRING		; on display
	LBSR	OPAREG		; with error number.
	LBRA	OPCRLF		; Newline and exit.
;
; This routine sends one command followed by a variable
; number of parameters, possibly none.
; X points to command, next byte is number of parameters
; X left pointing after last parameter, destroys D.
;
CMDPAR:	LDD	,X++		; Get command and number.
CP1:	TST	<FDCS		; Test status and
	BMI	CP1		; wait if busy.
	STA	<FDCC		; Send command
CP2:	DECB			; If no more parameters
	BMI	RTS2		; then exit.
CP4:	LDA	<FDCS		; If parameter
	BITA	#$20		; register full
	BNE	CP4		; then wait.
	LDA	,X+		; Get parameter and
	STA	<FDCP		; send it
	BRA	CP2		; then repeat.
;
; Test if drive ready, on entry X points to read drive
; status command sequence, on exit drive is ready and X points
; to next command sequence.
;
DRVRDY:	TFR	X,U		; Save pointer.
DR2:	TFR	U,X		; Restore pointer.
	BSR	CMDPAR		; Ask for drive status.
DR1:	LDA	<FDCS		; Wait until
	BITA	#$10		; result
	BEQ	DR1		; ready.
	LDA	<FDCR		; Get result.
	BITA	#$04		; Ready bit mask.
	BEQ	DR2		; Not ready, wait.
RTS2:	RTS

TRNSFR:	PSHS	CC		; Save CC while
	ORCC	#$50		; SEIF, set masks, disc is on NMI.
	LDB	#$04		; Data available mask.
	BRA	TRN2		;
TRN1:	LDA	<FDCD		; Get data
	STA	,U+		; and store it.
TRN2:	CWAI	#$FF		; Wait for interrupt.
	BITB	<FDCS		; Check data
	BNE	TRN1		; available.
	PULS	CC		; Get interrupt masks back
	LDA	<FDCR		; then get result
	RTS			; and return z bit accordingly.
;
; Interrupt request handler, comes here on IRQ active.
; Checks for timer 1 or keyboard interrupt, if neither
; then complains to user.
;

;			---- page 90 ----

IRQHAN:	LDA	#MONDP		; Set up
	TFR	A,DP		; direct page.
	SETDP	MONDP		; Tell assembler
	LDX	#KVIA		; Point to VIA address.
	LDA	KIFR-KVIA,X	; Get flag register.
	BPL	UNUSED		; Not the VIA!
	ANDA	#T1IFLG		; Try timer 1.
	BEQ	LFEF5		; Not timer 1.
	STA	KIFR-KVIA,X	; Clear the interrupt.
	JMP	[IRQRTS]	

LFEF5:	LDA	KIFR-KVIA,X	; Get flags again.
	ANDA	#CB1FLG		; Try for keyboard.
	BEQ	UNUSED 		; Query user if not.
	STA	KIFR-KVIA,X	; Clear the interrupt
	LDA	KIRB-KVIA,X	; and get a character
	ANDA	#$7F		; stripping spare bit.
	LBSR	HAVCHR		; Put into buffer
ANRTI:	RTI			; then leave IRQ level.
;
; Come here if unused interrupts are active, so
; complain to user and stop processor
; since cannot clear an unknown interrupt.
;
UNUSED:	LDX	#IERR		; Query user
	LBSR	STRING		; on display
FOREVR:	BRA	FOREVR		; and stop dead!
;
	IF	VDU<80
CRTCSV:	DB	$3F,COLS,$34,$44	; 40-column table for S version 6845 CRT controller.
	DB	$1E,$02,ROWS,$1B
	DB	$03,$12,$70,$13
CRTCRV:	DB	$3F,COLS,$34,$04	; 40-column table for R version 6845 CRT controller.
	DB	$1E,$02,ROWS,$1B
	DB	$00,$09,$68,$09

	ELSE

CRTCSV:	DB	$7F,COLS,$60,$A8	; 80-column table for S version 6845 CRT controller.
	DB	$1D,$02,ROWS,$1A
	DB	$03,$12,$70,$11
CRTCRV:	DB	$7F,COLS,$60,$A8	; 80-column table for R version 6845 CRT controller.
	DB	$1D,$02,ROWS,$1B
	DB	$00,$09,$68,$08
	ENDIF
;
; Set up table 1, copied directly to RAM at rptab1.
;
PTAB1:	dw	ISTACK		; Initial stack pointer.
	dw	0		; Trace initially off.
	db	BSPACE		; Character echoes on rubout.
	dB	$FF		; Echo on, line buffer on.
	db	0		; Printer off.
	db	LF		; Do not send line feeds, use CR only to printer.
	dw	205		; Initial baud rate for cassette is 300,
				; 110 baud use 564 ($0234),
				; 300 baud use 205 ($00CD),
				; 1200 baud use 48 ($0030).
	dw	DISPLA		; Console output.
	dw	GETCHR		; Console input.
	dw	MCASOP		; Cassette output.
	dw	MCASIN		; Cassette input.
	dw	PRINT		; Printer routine.
	dw	FUNCTS		; Display function table.
	dw	CMNDS		; Monitor command table.
	dw	UNUSED		; Initial timer 1 routine.
	dw	$0000		; No memory interpret.
LFF41:	dw	UNUSED		; Reserved vector.
	dw	UNUSED		; SWI3
	dw	UNUSED		; SWI2
	dw	UNUSED		; FIRQ
	dw	IRQHAN		; IRQ
	dw	SWIHAN		; SWI
	dw	UNUSED		; NMI
	dw	$0000		; Initial load offset.
PTAB2	EQU	$		; End of table.
;
; This table contains the standard set of commands
; provided by the monitor.
;
CMNDS:	db	(CMNDE-CMNDS)/3-1	; Number of entries.
	DB	"G"
	dw	GOUSER-CMNDS		; Go to program.
	DB	"M"
	dw	MEM-CMNDS		; Memory examine.
	DB	"R"
	dw	EXREG-CMNDS		; Examine registers.
	DB	"P"
	dw	RESUME-CMNDS		; Proceed after break.
	DB	"T"
	dw	TRACEN-CMNDS		; Set trace number.
	DB	"S"
	dw	SAVE-CMNDS		; Save on cassette.
	DB	"L"
	dw	LOAD-CMNDS		; Load from cassette.
	DB	"V"
	dw	BRKSET-CMNDS		; Set break address.
	DB	"D"
	dw	BOOT-CMNDS		; Disc bootstrap.
	DB	"C"
	dw	PCNTL-CMNDS		; Copy to printer.
	DB	SPACE
	dw	ANRTS-CMNDS		; Ignore spaces.
	DB	COMMA
	dw	ANRTS-CMNDS		; Ignore commas.
	DB	"."
	dw	TRACE-CMNDS		; Do trace operation.
	DB	"F"
	dw	LOAD7-CMNDS		; Finish file load.
	DB	1
	dw	BADCMD-CMNDS		; Default is query user.
CMNDE	equ $
;
; This table contains the standard functions provided
; by the VDU control programs.
;
FUNCTS:	DB	(FUNCTE-FUNCTS)/3-1	; Number of entries.
	DB	CR
	DW	DOCR-FUNCTS		; Carriage return.
	DB	LF
	DW	DOLF-FUNCTS		; Line feed.
	DB	BSPACE
	DW	DORUB-FUNCTS		; Rubout.
	DB	FFEED
	DW	CRTCI-FUNCTS		; Form feed.
	DB	1
	DW	SIMCHR-FUNCTS		; Default is display it.
FUNCTE	EQU $
;
; This is the list of strings used by the monitor.
;
MQRY:	db	"Rom?"
SCRLF:	db	CR,LF,0
TITLES:	db	"CC  A  B DP    X    Y    U   PC    S"
	db	CR,LF,0
PCMESS:	db	CR,LF
	db	"PC]"
	db	0
CQRY:	db	"What is:"
	db	0
IERR:	db	"I"
LQRY:	db	"-"
DQRY:	db	"Err "
	db	0
;
; This is the set of indirect jumps to redirect
; the interrupt vector addresses.
;
RESVI:	JMP	[IRESV]
SWI3I:	JMP	[ISWI3]
SWI2I:	JMP	[ISWI2]
FIRQI:	JMP	[IFIRQ]
IRQI:	JMP	[IIRQ]
SWII:	JMP	[ISWI]
NMII:	JMP	[INMI]
	db	$00
;
; The following hardware vectors reside in the top
; 16 bytes of memory when the monitor is in its
; standard position.
;
;	ORG	$FFF0
;	PUT	$E7F0

	dw	RESVI
	dw	SWI3I
	dw	SWI2I
	dw	FIRQI
	dw	IRQI
	dw	SWII
	dw	NMII
	dw	RESET

	END