;  PROGRAM:  SYSRCP.ASM
;  AUTHOR:  RICHARD CONN
;  VERSION:  1.0
;  DATE:  3 FEB 84
;  PREVIOUS VERSIONS:  NONE
;

VERSION	EQU	14

;  11/22/85  Jay Sage
;	Small tweak to fix an omission in the code for testing for SLRMAC
;	errors in TST command.  Also corrected a small error in PEEK
;	command (changed a 256 to 255 to make it show one page as default).

;  10/14/85  Jay Sage
;	Added support for SLRMAC to TST command.  Version number changed
;	to 1.4.  The code in TESTERR was shortened by making use of the
;	relaxed definition of the program error flag setting (any non-zero
;	value indicates an error condition).

;  09/06/85  Jay Sage
;	Version 1.3.  Modified peek command to work with last page of
;	memory by changing the code for detecting the end of the specified
;	memory range to handle overflow past FFFF.  I added a new equate in
;	the code below (PEEKCHK).  If PEEKCHK is TRUE, then a peek command
;	display will never go past address FFFF to 0000.  This feature costs
;	five extra bytes, so some people may want to disable it.  The command
;	"P 100 100" will now work and display one line of bytes.  Corrected
;	error in @GENDD macro and renamed macros for ZAS compatibility.  
;	Changed name of symbols I and J to II and JJ because the symbol I
;	conflicts with the I register of the Z80.  A bug in ZAS V2.0 prevents
;	it from assembling the file to a correct hex file (later versions will,
;	one hopes, correct this problem).  ZAS V1.4 can be used if the files
;	in the MACLIB statements below are changed to include the file type
;	LIB explicitly.

;  07/21/85  Jay Sage
;	Version 1.2.  Added TST command to test the program error flag.
;	Also made CLS command optionally use TCAP for clear screen sequence.

;  04/28/85  Jay Sage
;	Added WHLQUIET equate to make WHL command not report wheel status
;  changes as an added measure of security, especially during alias operations
;  that set the wheel byte temporarily.  An RCPM user might, on seeing the
;  'whl byte on' message, try to interrupt program execution.

;  02/22/85  Jay Sage
;	Corrected omission of wheel check based on WREG equate in SYSRCP.LIB.

;  02/14/85  Jay Sage
;	Modified CP command to use the top of the TPA for buffering so
;	that the GO command will still work in most cases after CP is
;	finished.  The equate COPYTOP determines whether the new or the
;	old code will be generated.

;  02/13/85  Jay Sage
;	Added code for an R (disk reset) and a CLS (clear screen) function.

;
;	SYSRCP is a resident command processor for ZCPR3.  As with
; all resident command processors, SYSRCP performs the following functions:
;
;		1.  Assuming that the EXTFCB contains the name of the
;			command, SYSRCP looks to see if the first character
;			of the file name field in the EXTFCB is a question
;			mark; if so, it returns with the Zero Flag Set and
;			HL pointing to the internal routine which prints
;			its list of commands
;		2.  The resident command list in SYSRCP is scanned for
;			the entry contained in the file name field of
;			EXTFCB; if found, SYSRCP returns with the Zero Flag
;			Set and HL pointing to the internal routine which
;			implements the function; if not found, SYSRCP returns
;			with the Zero Flag Reset (NZ)
;

;
;  Global Library which Defines Addresses for SYSRCP
;
	MACLIB	Z3BASE	; USE BASE ADDRESSES
	MACLIB	SYSRCP	; USE SYSRCP HEADER


PEEKCHK	EQU	TRUE			;<JPS> SET TRUE TO INCLUDE CODE TO
					;PREVENT OVERFLOW PAST FFFF WITH PEEK
					;COMMAND (COSTS 5 BYTES OF CODE)

CTRLC	EQU	'C'-'@'
TAB	EQU	09H
LF	EQU	0AH
FF	EQU	0CH
CR	EQU	0DH
CTRLX	EQU	'X'-'@'
CTRLZ	EQU	'Z'-'@'			;<JPS>

WBOOT	EQU	BASE+0000H		;CP/M WARM BOOT ADDRESS
UDFLAG	EQU	BASE+0004H		;USER NUM IN HIGH NYBBLE, DISK IN LOW
BDOS	EQU	BASE+0005H		;BDOS FUNCTION CALL ENTRY PT
TFCB	EQU	BASE+005CH		;DEFAULT FCB BUFFER
FCB1	EQU	TFCB			;1st and 2nd FCBs
FCB2	EQU	TFCB+16
TBUFF	EQU	BASE+0080H		;DEFAULT DISK I/O BUFFER
TPA	EQU	BASE+0100H		;BASE OF TPA
DIRBUF	EQU	BASE+4000H		;DIR BUFFER (MANY ENTRIES PERMITTED)
PAGCNT	EQU	DIRBUF-100H		;PAGE COUNT BUFFER
OLDFCB	EQU	PAGCNT+1		;OLD FCB BUFFER
;CPBLOCKS	EQU	64		;BUF SIZE - MOVED TO SYSRCP.LIB <JPS>


; MACROS TO PROVIDE Z80 EXTENSIONS
;   MACROS INCLUDE:
;
;	BR	- JUMP RELATIVE
;	BRC	- JUMP RELATIVE IF CARRY
;	BRNC	- JUMP RELATIVE IF NO CARRY
;	BRZ	- JUMP RELATIVE IF ZERO
;	BRNZ	- JUMP RELATIVE IF NO ZERO
;	DBNZ	- DECREMENT B AND JUMP RELATIVE IF NO ZERO
;
;	@GENDD MACRO USED FOR CHECKING AND GENERATING
;	8-BIT JUMP RELATIVE DISPLACEMENTS
;
@GENDD	MACRO	?DD	;;USED FOR CHECKING RANGE OF 8-BIT DISPLACEMENTS
	IF [?DD GT 7FH] AND [?DD LT 0FF80H]
	DB	100H	;Displacement Range Error on Jump Relative
	ELSE
	DB	?DD
	ENDIF		;;RANGE ERROR
	ENDM


; Z80 MACRO EXTENSIONS

BR	MACRO	?N	;;JUMP RELATIVE
	IF	I8080	;;8080/8085
	JP	?N
	ELSE		;;Z80
	DB	18H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM

BRC	MACRO	?N	;;JUMP RELATIVE ON CARRY
	IF	I8080	;;8080/8085
	JP	C,?N
	ELSE		;;Z80
	DB	38H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM

BRNC	MACRO	?N	;;JUMP RELATIVE ON NO CARRY
	IF	I8080	;;8080/8085
	JP	NC,?N
	ELSE		;;Z80
	DB	30H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM

BRZ	MACRO	?N	;;JUMP RELATIVE ON ZERO
	IF	I8080	;;8080/8085
	JP	Z,?N
	ELSE		;;Z80
	DB	28H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM

BRNZ	MACRO	?N	;;JUMP RELATIVE ON NO ZERO
	IF	I8080	;;8080/8085
	JP	NZ,?N
	ELSE		;;Z80
	DB	20H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM

DBNZ	MACRO	?N	;;DECREMENT B AND JUMP RELATIVE ON NO ZERO
	IF	I8080	;;8080/8085
	DEC	B
	JP	NZ,?N
	ELSE		;;Z80
	DB	10H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
;  SYSTEM Entry Point
;
	org	rcp		; passed for Z3BASE

	db	'Z3RCP'		; Flag for Package Loader
;
;  **** Command Table for RCP ****
;	This table is RCP-dependent!
;
;	The command name table is structured as follows:
;
;	ctable:
;		DB	'CMNDNAME'	; Table Record Structure is
;		DW	cmndaddress	; 8 Chars for Name and 2 Bytes for Adr
;		...
;		DB	0	; End of Table
;
cnsize	equ	cmdlen		; NUMBER OF CHARS IN COMMAND NAME
	db	cnsize	; size of text entries

ctab:
	HELPCMD		;macro to provide name of help command
;	db	'H   '	; Help for RCP
	dw	clist

ctab1:

	IF	CLSON
	CLSCMD		;macro to provide name of clear screen command
;	db	'CLS '	; Clear Screen
	dw	cls
	ENDIF		;CLSON

	IF	CPON
	CPCMD		;macro to provide name of copy command
;	db	'CP  '	; Copy
	dw	copy
	ENDIF		;CPON

	IF	DIRON
	DIRCMD		;macro to provide name of directory command
;	db	'DIR '	; Directory
	dw	dir
	ENDIF		;DIRON

	IF	ECHOON
	ECHOCMD		;macro to provide name of echo command
;	db	'ECHO'	; Echo
	dw	echo
	ENDIF

	IF	ERAON
	ERACMD		;macro to provide name of erase command
;	db	'ERA '	; Erase
	dw	era
	ENDIF		;ERAON

	IF	LTON AND LISTON
	LISTCMD		;macro to provide name of list command
;	db	'LIST'	; List
	dw	list
	ENDIF		;LTON AND LISTON

	IF	NOTEON
	NOTECMD		;macro to provide name of note command
;	db	'NOTE'	; Note-Comment-NOP Command
	dw	note
	ENDIF

	IF	PEEKON
	PEEKCMD		;macro to provide name of peek command
;	db	'P   '	; Peek into Memory
	dw	peek
	ENDIF		;PEEKON

	IF	POKEON
	POKECMD		;macro to provide name of poke command
;	db	'POKE'	; Poke Values into Memory
	dw	poke
	ENDIF		;POKEON

	IF	PROTON
	PROTCMD		;macro to provide name of protect command
;	db	'PROT'	; Protection Codes
	dw	att
	ENDIF		;PROTON

	IF	RESON
	RESETCMD	;macro to provide name of disk reset command
;	db	'R   '
	dw	reset
	ENDIF		;RESON

	IF	REGON
	REGCMD		;macro to provide name of register command
;	db	'REG '	; Register Command
	dw	register
	ENDIF		;RSETON

	IF	RENON
	RENCMD		;macro to provide name of rename command
;	db	'REN '	; Rename
	dw	ren
	ENDIF		;RENON

	IF	TSTON
	TESTCMD		;macro to provide name of error testing command
;	db	'TST '	; Type
	dw	testerr
	ENDIF		;LTON

	IF	LTON
	TYPECMD		;macro to provide name of type command
;	db	'TYPE'	; Type
	dw	type
	ENDIF		;LTON

	IF	WHLON
	WHLCMD		;macro to provide name of wheel setting command
;	db	'WHL '	; Wheel
	dw	whl
	WHLQCMD		;macro to provide name of wheel query command
;	db	'WHLQ'	; Wheel Query
	dw	whlmsg
	ENDIF		;WHLON
;
	db	0
;
;  BANNER NAME OF RCP
;
rcp$name:
	db	'SYS '
	db	[version/10]+'0','.',[version mod 10]+'0'
	db	rcpid
	db	0

;
;  Command List Routine
;
clist:
	ld	hl,rcp$name	; print RCP Name
	call	print1
	ld	hl,ctab1		; print table entries
	ld	c,1		; set count for new line
clist1:
	ld	a,(hl)		; done?
	or	a
	ret	z
	dec	c		; count down
	brnz	clist1a
	call	crlf		; new line
	ld	c,4		; set count
clist1a:
	ld	de,entryname	; copy command name into message buffer
	ld	b,cnsize	; number of chars
clist2:
	ld	a,(hl)		; copy
	ld	(de),a
	inc	hl		; pt to next
	inc	de
	dec	b
	jp	nz,clist2
	inc	hl		; skip to next entry
	inc	hl
	push	hl		; save ptr
	ld	hl,entrymsg	; print message
	call	print1
	pop	hl		; get ptr
	jp	clist1
;
;  Console Output Routine
;
conout:
	push	hl		; save regs
	push	de
	push	bc
	push	af
	and	7fh		; mask MSB
	ld	e,a		; char in E
	ld	c,2		; output
	call	bdos
	pop	af		; get regs
	pop	bc
	pop	de
	pop	hl
;
;  This simple return doubles for the NOTE Command (NOP) and CONOUT Exit
;  NOTE Command: NOTE any text
;
NOTE:
	ret
;
;  Print String (terminated in 0 or MSB Set) at Return Address
;
print:
	ex	(sp),hl			; get address
	call	print1
	ex	(sp),hl			; put address
	ret
;
;  Print String (terminated in 0 or MSB Set) pted to by HL
;
print1:
	ld	a,(hl)		; done?
	inc	hl		; pt to next
	or	a		; 0 terminator
	ret	z
	call	conout		; print char
	ret	m			; MSB terminator
	jp	print1
;
;  CLIST Messages
;
entrymsg:
	db	'  '		; command name prefix
entryname:
	ds	cnsize	; command name
	db	0	; terminator

;
;  **** RCP Routines ****
;  All code from here on is RCP-dependent!
;

;
;Section 4A
;Command: CLS
;Function:  To clear the CRT screen
;Restrictions:  The setting of the CLSTCAP equate determines whether this
;		command uses the TCAP information or not.  If not, it uses the
;		clear-screen string passed in macro CLSSTR.  That string should
;		end with the high bit set.
;
	IF	CLSON
CLS:
	IF	CLSTCAP		;if using TCAP for clear screen string
	LD	HL,Z3ENV+80H	;point to beginning of TCAP
	LD	A,(HL)		;see if blank
	CP	' '+1
	BRNC	CLS1		;if not, go to clear screen code
	CALL	PRINT		;if blank, then give error message
	DB	' NO TCA','P'+80H
	RET
CLS1:	LD	HL,Z3ENV+97H	;point to beginning of clear screen string
CLS2:	LD	A,(HL)		;get character
	OR	A		;test for end of string
	RET	Z
	CALL	CONOUT		;send character to console
	INC	HL		;point to next character
	BR	CLS2

	ELSE	;NOT USING TCAP

	CALL	PRINT
	CLSSTR		;string from SYSRCP.LIB
	RET

	ENDIF	;CLSTCAP

	ENDIF		;CLSON

;
;Section 4B
;Command: RESET
;Function:  To reset the disk system to force relogging in of disks
;Comments:	ZRDOS does not require a disk system reset when disks are
;		changed, but directory programs will not show the correct
;		size if this is not done.
;
	IF	RESON
RESET:
	LD	C,13	;disk reset BDOS function
	 IF	RESMSG
	CALL	BDOS	;reset disk system
	CALL	PRINT	;report action
	DB	'rese','t'+80H
	RET
	 ELSE	;NOT RESMSG
	JP	BDOS	;call BDOS and return
	 ENDIF	;RESMSG
	ENDIF		;RESON

;Section 4C
;Command: TST
;Function:  To set the message buffer program error flag based on
;		error count reported by ZAS, M80, or L80
;Forms:     TST PN  where PN is first letter of ZAS, M80, or L80

	IF	TSTON

; Equates for addresses where error counts are kept by the programs to be tested

		; M80/F80, Version 3.44

m80f	equ	03cedh		;addr of word with fatal error count (M80)
m80w	equ	03cefh		;addr of word with warning error count (M80)

f80f	equ	001c1h		;addr of word with fatal error count (F80)
f80w	equ	002adh		;addr of word with warning error count (F80)

		; ZAS Version 2.0

zasf	equ	010a2h		;addr of word with fatal error count (ZAS2.1)

		; SLRMAC version 1.04

slrf	equ	06679h		;addr of ascii error count with SLRMAC


testerr:

	if	z3msg eq 0	;if no message buffer, give error message

        ;** ERROR ***
this code cannot be used unless the 
ZCPR3 MESSAGE BUFFER IS IMPLEMENTED

	else			;generate code

		;check for name of program to test

	ld	a,(fcb1+1)		;get first character in command tail

	if	testm80
	ld	hl,m80f		;preset for M80 test counts
	ld	de,m80w
	cp	'M'
	brz	testcount
	endif	;testm80

	if	testf80
	ld	hl,f80f
	ld	de,f80w
	cp	'F'
	brz	testcount
	endif	;testf80

	if	testzas
	ld	hl,zasf
	ld	d,h		;use zasf twice (shorter code)
	ld	e,l		;since ZAS has only one count
	cp	'Z'
	brz	testcount
	endif	;testzas

	if	testslr
	cp	'S'
	brnz	badname
	ld	hl,slrf
	ld	a,(hl)		;code put in here because error count is not
	sub	' '		;..in binary; we must test ascii string
	ld	b,a
	inc	hl
	ld	a,(hl)
	sub	'0'
	or	b
	br	setflag
	endif	;testslr

		;if no match, give error message

badname:
	call	print
badtailmsg:
	db	'bad nam'
	db	'e' or 80h

	if	testm80 or testf80 or testzas
testcount:
	ld	a,(hl)		;test first error count word
	inc	hl
	or	(hl)
	ex	de,hl			;test second word
	or	(hl)
	inc	hl
	or	(hl)
	endif

setflag:
	ld	(z3msg+6),a		;store value in program error flag
	ret

	endif	;z3msg

	ENDIF	;TSTON

;
;Section 5A
;Command: DIR
;Function:  To display a directory of the files on disk
;Forms:
;	DIR <afn>	Displays the DIR files
;	DIR <afn> S	Displays the SYS files
;	DIR <afn> A	Display both DIR and SYS files
;Notes:
;	The flag SYSFLG defines the letter used to display both DIR and
;		SYS files (A in the above Forms section)
;	The flag SOFLG defines the letter used to display only the SYS
;		files (S in the above Forms section)
;	The flag WIDE determines if the file names are spaced further
;		apart (WIDE=TRUE) for 80-col screens
;	The flag FENCE defines the character used to separate the file
;		names
;
	IF	DIRON
DIR:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
	IF	WDIR
	CALL	WHLTST
	ENDIF		;WHEEL APPROVAL
;
	CALL	RETSAVE		;SAVE RET ADDRESS AND SET STACK
	LD	HL,FCB1+1 	;MAKE FCB WILD (ALL '?') IF NO FILENAME.TYP
	LD	A,(HL)		;GET FIRST CHAR OF FILENAME.TYP
	CP	' '		;IF <SP>, ALL WILD
	CALL	Z,FILLQ
	LD	A,(FCB2+1)		;GET FIRST CHAR OF 2ND FILE NAME
	LD	B,80H		;PREPARE FOR DIR-ONLY SELECTION
	CP	' '		;ANY FLAG?
	BRZ	DIRPR		;THERE IS NO FLAG, SO DIR ONLY
	LD	B,1		;SET FOR BOTH DIR AND SYS FILES
	CP	SYSFLG		;SYSTEM AND DIR FLAG SPECIFIER?
	BRZ	DIRPR		;GOT SYSTEM SPECIFIER
	CP	SOFLG		;SYS ONLY?
	BRNZ	DIRPR
	DEC	B		;B=0 FOR SYS FILES ONLY
;
	ENDIF		;DIRON
;
; DIRECTORY PRINT ROUTINE; ON ENTRY, B REG IS SET AS FOLLOWS:
;	0 FOR ONLY SYSTEM FILES, 80H FOR ONLY DIR FILES, 1 FOR BOTH
;
	IF	DIRON OR ERAON OR LTON OR PROTON OR CPON OR RENON
DIRPR:
	LD	A,B		;GET SYSTST FLAG
	CALL	GETDIR		;LOAD AND SORT DIRECTORY
	JP	Z,PRFNF		;PRINT NO FILE MESSAGE
	LD	E,4		;COUNT DOWN TO 0
;
; ENTRY PRINT LOOP; ON ENTRY, HL PTS TO FILES SELECTED (TERMINATED BY 0)
;	AND E IS ENTRY COUNTER
;
DIR3:
	LD	A,(HL)		;CHECK FOR DONE
	OR	A
	JP	Z,EXIT		;EXIT IF DONE
	LD	A,E		;GET ENTRY COUNTER
	OR	A		;OUTPUT <CRLF> IF 4 ENTRIES PRINTED IN LINE
	CALL	Z,DIRCRLF		;NEW LINE
	LD	A,E		;GET ENTRY COUNT
	CP	4		;FIRST ENTRY?
	BRZ	DIR4
	CALL	PRINT
;
	IF	WIDE
;
	DB	'  '		;2 SPACES
	DB	FENCE		;THEN FENCE CHAR
	DB	' '+80H		;THEN 1 MORE SPACE
;
	ELSE
;
	DB	' '		;SPACE
	DB	FENCE+80H	;THEN FENCE CHAR
;
	ENDIF			;WIDE
;
DIR4:
	CALL	PRFN		;PRINT FILE NAME
	CALL	BREAK		;CHECK FOR ABORT
	DEC	E		;DECREMENT ENTRY COUNTER
	BR	DIR3
;
; CRLF FOR DIR ROUTINE
;
DIRCRLF:
	PUSH	AF		;DON'T AFFECT PSW
	CALL	CRLF		;NEW LINE
	POP	AF
	LD	E,4		;RESET ENTRY COUNTER
	RET
;
; AFTER A SEARCH, RETURN NZ SET IF DESIRED TYPE OF FILE FOUND, Z IF NOT
;   THIS ALGORITHM LOOKS AT THE SYSTEM BIT OF THE LOCATED FILE; THIS
;   BIT IS SET TO 1 IF THE FILE IS A SYSTEM FILE AND 0 IF NOT A SYSTEM
;   FILE.  THE FOLLOWING EXCLUSIVE OR MASKS ARE APPLIED TO RETURN Z OR NZ
;   AS REQUIRED BY THE CALLING PROGRAM:
;
;	SYSTEM BYTE: X 0 0 0  0 0 0 0   (AFTER 80H MASK, X=1 IF SYS, 0 IF DIR)
;
;	SYS-ONLY   : 0 0 0 0  0 0 0 0   (XOR 0 = 0 if X=0, = 80H if X=1)
;	DIR-ONLY   : 1 0 0 0  0 0 0 0   (XOR 80H = 80h if X=0, = 0 if X=1)
;	BOTH       : 0 0 0 0  0 0 0 1   (XOR 1 = 81H or 1H, NZ in both cases)
;
GETSBIT:
	DEC	A		;ADJUST TO RETURNED VALUE
	RRCA			;CONVERT NUMBER TO OFFSET INTO TBUFF
	RRCA
	RRCA
	AND	60H
	LD	C,A		;OFFSET INTO TBUFF IN C (C=OFFSET TO ENTRY)
	LD	DE,TBUFF		;PT TO BUFFER
	LD	A,E		;BASE ADDRESS IN A
	ADD	A,C		;ADD IN ENTRY OFFSET
	LD	E,A		;RESULT IN E
	PUSH	DE		;SAVE PTR IN DE
	ADD	10		;ADD OFFSET OF 10 TO PT TO SYSTEM BYTE
	LD	E,A		;SET ADDRESS
	LD	A,(DE)		;GET BYTE
	POP	DE		;GET PTR IN DE
	AND	80H		;LOOK AT ONLY SYSTEM BIT
SYSTST	EQU	$+1		;IN-THE-CODE VARIABLE
	XOR	0		; IF SYSTST=0, SYS ONLY; IF SYSTST=80H, DIR
				; ONLY; IF SYSTST=1, BOTH SYS AND DIR
	RET			;NZ IF OK, Z IF NOT OK
;
; FILL FCB @HL WITH '?'
;
FILLQ:
	LD	B,11		;NUMBER OF CHARS IN FN & FT
	LD	A,'?'		;STORE '?'
FILLP:
	LD	(HL),A		;STORE BYTE
	INC	HL		;PT TO NEXT
	DBNZ	FILLP		;COUNT DOWN
	RET
;
; LOAD DIRECTORY AND SORT IT
;   ON INPUT, A=SYSTST FLAG (0=SYS, 1=DIR, 80H=BOTH)
;   DIRECTORY IS LOADED INTO DIRBUF
;   RETURN WITH ZERO SET IF NO MATCH AND HL PTS TO 1ST ENTRY IF MATCH
;
GETDIR:
	LD	(SYSTST),A	; SET SYSTEM TEST FLAG
	CALL	LOGUSR	; LOG INTO USER AREA OF FCB1
	LD	HL,DIRBUF	; PT TO DIR BUFFER
	LD	(HL),0	; SET EMPTY
	LD	BC,0	; SET COUNTER
	CALL	SEARF	; LOOK FOR MATCH
	RET	Z		; RETURN IF NOT FOUND
;
;  STEP 1:  LOAD DIRECTORY
;
GD1:
	PUSH	BC	; SAVE COUNTER
	CALL	GETSBIT	; CHECK FOR SYSTEM OK
	POP	BC
	BRZ	GD2	; NOT OK, SO SKIP
	PUSH	BC	; SAVE COUNTER
	INC	DE	; PT TO FILE NAME
	EX	DE,HL		; HL PTS TO FILE NAME, DE PTS TO BUFFER
	LD	B,11	; COPY 11 BYTES
	CALL	LDIR	; DO COPY
	EX	DE,HL		; HL PTS TO NEXT BUFFER LOCATION
	POP	BC	; GET COUNTER
	INC	BC	; INCREMENT COUNTER
GD2:
	CALL	SEARN	; LOOK FOR NEXT
	BRNZ	GD1
	LD	(HL),0	; STORE ENDING 0
	LD	HL,DIRBUF	; PT TO DIR BUFFER
	LD	A,(HL)	; CHECK FOR EMPTY
	OR	A
	RET	Z
;
;  STEP 2:  SORT DIRECTORY
;
	PUSH	HL	; SAVE PTR TO DIRBUF FOR RETURN
	CALL	DIRALPHA	; SORT
	POP	HL
	XOR	A	; SET NZ FLAG FOR OK
	DEC	A
	RET

;
;  DIRALPHA -- ALPHABETIZES DIRECTORY IN DIRBUF; BC CONTAINS
;	THE NUMBER OF FILES IN THE DIRECTORY
;
DIRALPHA:
	LD	A,B	; ANY FILES?
	OR	C
	RET	Z
	LD	H,B	; HL=BC=FILE COUNT
	LD	L,C
	LD	(N),HL	; SET "N"
;
;  SHELL SORT --
;    THIS SORT ROUTINE IS ADAPTED FROM "SOFTWARE TOOLS"
;    BY KERNIGAN AND PLAUGHER, PAGE 106.  COPYRIGHT, 1976, ADDISON-WESLEY.
;  ON ENTRY, BC=NUMBER OF ENTRIES
;
N	EQU	$+1	; POINTER FOR IN-THE-CODE MODIFICATION
	LD	HL,0	; NUMBER OF ITEMS TO SORT
	LD	(GAP),HL	; SET INITIAL GAP TO N FOR FIRST DIVISION BY 2

;  FOR (GAP = N/2; GAP > 0; GAP = GAP/2)
SRTL0:
	OR	A	; CLEAR CARRY
GAP	EQU	$+1	; POINTER FOR IN-THE-CODE MODIFICATION
	LD	HL,0	; GET PREVIOUS GAP
	LD	A,H	; ROTATE RIGHT TO DIVIDE BY 2
	RRA
	LD	H,A
	LD	A,L
	RRA
	LD	L,A

;  TEST FOR ZERO
	OR	H
	RET	Z		; DONE WITH SORT IF GAP = 0

	LD	(GAP),HL	; SET VALUE OF GAP
	LD	(II),HL	; SET II=GAP FOR FOLLOWING LOOP

;  FOR (II = GAP + 1; II <= N; II = II + 1)
SRTL1:
II	EQU	$+1	; POINTER FOR IN-THE-CODE MODIFICATION
	LD	HL,0	; ADD 1 TO II
	INC	HL
	LD	(II),HL

;  TEST FOR II <= N
	EX	DE,HL		; II IS IN DE
	LD	HL,(N)	; GET N
	LD	A,L	; COMPARE BY SUBTRACTION
	SUB	E
	LD	A,H
	SBC	A,D	; CARRY SET MEANS II > N
	BRC	SRTL0	; DON'T DO FOR LOOP IF II > N

	LD	HL,(II)	; SET JJ = II INITIALLY FOR FIRST SUBTRACTION OF GAP
	LD	(JJ),HL

;  FOR (JJ = II - GAP; JJ > 0; JJ = JJ - GAP)
SRTL2:
	LD	HL,(GAP)	; GET GAP
	EX	DE,HL		; ... IN DE
JJ	EQU	$+1	; POINTER FOR IN-THE-CODE MODIFICATION
	LD	HL,0	; GET JJ
	LD	A,L	; COMPUTE JJ - GAP
	SUB	E
	LD	L,A
	LD	A,H
	SBC	A,D
	LD	H,A
	LD	(JJ),HL	; JJ = JJ - GAP
	BRC	SRTL1	; IF CARRY FROM SUBTRACTIONS, JJ < 0 AND ABORT
	LD	A,H	; JJ=0?
	OR	L
	BRZ	SRTL1	; IF ZERO, JJ=0 AND ABORT

;  SET JG = JJ + GAP
	EX	DE,HL		; JJ IN DE
	LD	HL,(GAP)	; GET GAP
	ADD	HL,DE	; JJ + GAP
	LD	(JG),HL	; JG = JJ + GAP

;  IF (V(JJ) <= V(JG))
	CALL	ICOMPARE	; J IN DE, JG IN HL

;  ... THEN BREAK
	BRC	SRTL1

;  ... ELSE EXCHANGE
	LD	HL,(JJ)	; SWAP JJ, JG
	EX	DE,HL
JG	EQU	$+1	; POINTER FOR IN-THE-CODE MODIFICATION
	LD	HL,0
	CALL	ISWAP	; JJ IN DE, JG IN HL

;  END OF INNER-MOST FOR LOOP
	BR	SRTL2

;
;  SWAP (Exchange) the elements whose indexes are in HL and DE
;
ISWAP:
	CALL	IPOS		; COMPUTE POSITION FROM INDEX
	EX	DE,HL
	CALL	IPOS		; COMPUTE 2ND ELEMENT POSITION FROM INDEX
	LD	B,11		; 11 BYTES TO FLIP
ISWAP1:
	LD	A,(DE)		; GET BYTES
	LD	C,(HL)
	LD	(HL),A		; PUT BYTES
	LD	A,C
	LD	(DE),A
	INC	HL		; PT TO NEXT
	INC	DE
	DBNZ	ISWAP1
	RET
;
;  ICOMPARE compares the entry pointed to by the pointer pointed to by HL
;    with that pointed to by DE (1st level indirect addressing); on entry,
;    HL and DE contain the numbers of the elements to compare (1, 2, ...);
;    on exit, Carry Set means ((DE)) < ((HL)), Zero Set means ((HL)) = ((DE)),
;    and Non-Zero and No-Carry means ((DE)) > ((HL))
;
ICOMPARE:
	CALL	IPOS		; GET POSITION OF FIRST ELEMENT
	EX	DE,HL
	CALL	IPOS		; GET POSITION OF 2ND ELEMENT
	EX	DE,HL
;
;  COMPARE DIR ENTRY PTED TO BY HL WITH THAT PTED TO BY DE;
;	NO NET EFFECT ON HL, DE; RET W/CARRY SET MEANS DE<HL
;	RET W/ZERO SET MEANS DE=HL
;
	IF	NOT SORTNT	; TYPE AND NAME?
;
;  COMPARE BY FILE TYPE AND FILE NAME
;
	PUSH	HL
	PUSH	DE
	LD	BC,8	; PT TO FT (8 BYTES)
	ADD	HL,BC
	EX	DE,HL
	ADD	HL,BC
	EX	DE,HL		; DE, HL NOW PT TO THEIR FT'S
	LD	B,3	; 3 BYTES
	CALL	COMP	; COMPARE FT'S
	POP	DE
	POP	HL
	RET	NZ		; CONTINUE IF COMPLETE MATCH
	LD	B,8	; 8 BYTES
	BR	COMP	; COMPARE FN'S
;
	ELSE		; NAME AND TYPE
;
;  COMPARE BY FILE NAME AND FILE TYPE
;
	LD	B,11	; COMPARE FN, FT AND FALL THRU TO COMP
;
;  COMP COMPARES DE W/HL FOR B BYTES; RET W/CARRY IF DE<HL
;	MSB IS DISREGARDED
;
COMP:
	LD	A,(HL)	; GET (HL)
	AND	7FH	; MASK MSB
	LD	C,A	; ... IN C
	LD	A,(DE)	; COMPARE
	AND	7FH	; MASK MSB
	CP	C
	RET	NZ
	INC	HL	; PT TO NEXT
	INC	DE
	DBNZ	COMP	; COUNT DOWN
	RET
;
	ENDIF		; NOT SORTNT
;
;  Compute physical position of element whose index is in HL; on exit, HL
; is the physical address of this element; Indexes are 1..N
;
IPOS:
	DEC	HL		; HL=(HL-1)*11+DIRBUF
	LD	B,H		; BC=HL
	LD	C,L
	ADD	HL,HL		; HL=HL*2
	ADD	HL,HL		; HL=HL*4
	ADD	HL,BC		; HL=HL*5
	ADD	HL,HL		; HL=HL*10
	ADD	HL,BC		; HL=HL*11
	LD	BC,DIRBUF	; ADD IN DIRBUF
	ADD	HL,BC
	RET
;
	ENDIF		;DIRON OR ERAON OR LTON OR PROTON OR CPON OR RENON
;
;Section 5B
;Command: ERA
;Function:  Erase files
;Forms:
;	ERA <afn>	Erase Specified files and print their names
;	ERA <afn> I	Erase Specified files and print their names, but ask
;				for verification before Erase is done
;
	IF	ERAON
ERA:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
	IF	WERA
	CALL	WHLTST
	ENDIF		;WHEEL APPROVAL
;
	CALL	RETSAVE
	LD	A,(FCB2+1)		;GET ERAFLG IF IT'S THERE
	LD	(ERAFLG),A		;SAVE IT AS A FLAG
	LD	A,1		;DIR FILES ONLY
	CALL	GETDIR		;LOAD DIRECTORY OF FILES
	JP	Z,PRFNF		;ABORT IF NO FILES
;
; MAIN ERASE LOOP
;
ERA1:
	PUSH	HL		;SAVE PTR TO FILE
	CALL	PRFN		;PRINT ITS NAME
	LD	(NXTFILE),HL		;SAVE PTR TO NEXT FILE
	POP	HL		;GET PTR TO THIS FILE
	CALL	ROTEST		;TEST FILE PTED TO BY HL FOR R/O
	BRNZ	ERA3
ERAFLG	EQU	$+1		;ADDRESS OF FLAG
	LD	A,0		;2ND BYTE IS FLAG
	CP	'I'		;IS IT AN INSPECT OPTION?
	BRNZ	ERA2		;SKIP PROMPT IF IT IS NOT
	CALL	ERAQ		;ERASE?
	BRNZ	ERA3		;SKIP IF NOT
ERA2:
	LD	DE,FCB1+1	;COPY INTO FCB1
	LD	B,11		;11 BYTES
	CALL	LDIR
	CALL	INITFCB1	;INIT FCB
	LD	C,19		;DELETE FILE
	CALL	BDOS
ERA3:
	LD	HL,(NXTFILE)		;HL PTS TO NEXT FILE
	LD	A,(HL)		;GET CHAR
	OR	A		;DONE?
	JP	Z,EXIT
	CALL	CRLF		;NEW LINE
	BR	ERA1
;
	ENDIF		;ERAON
;
;Section 5C
;Command: LIST
;Function:  Print out specified file on the LST: Device
;Forms:
;	LIST <afn>	Print file (NO Paging)
;Notes:
;	The flags which apply to TYPE do not take effect with LIST
;
	IF	LTON
LIST:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
	IF	WLIST
	CALL	WHLTST
	ENDIF		;WHEEL APPROVAL
;
	CALL	RETSAVE
	LD	A,0FFH		;TURN ON PRINTER FLAG
	BR	TYPE0
;
;Section 5D
;Command: TYPE
;Function:  Print out specified file on the CON: Device
;Forms:
;	TYPE <afn>	Print file
;	TYPE <afn> P	Print file with paging flag	
;Notes:
;	The flag PGDFLG defines the letter which toggles the paging
;		facility (P in the forms section above)
;	The flag PGDFLT determines if TYPE is to page by default
;		(PGDFLT=TRUE if TYPE pages by default); combined with
;		PGDFLG, the following events occur --
;			If PGDFLT = TRUE, PGDFLG turns OFF paging
;			If PGDFLT = FALSE, PGDFLG turns ON paging
;
TYPE:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
	IF	WTYPE
	CALL	WHLTST
	ENDIF		;WHEEL APPROVAL
;
	CALL	RETSAVE
	XOR	A		;TURN OFF PRINTER FLAG
;
; ENTRY POINT FOR CPR LIST FUNCTION (LIST)
;
TYPE0:
	LD	(PRFLG),A		;SET FLAG
	LD	A,(FCB2+1)		;GET PAGE FLAG
	LD	(PGFLG),A		;SAVE IT AS A FLAG
	LD	A,1		;SELECT DIR FILES
	CALL	GETDIR		;ALLOW AMBIGUOUS FILES
	JP	Z,PRFNF		;NO FILES
	LD	(NXTFILE),HL		;SET PTR TO NEXT FILE
	BR	TYPEX2
TYPEX:
	LD	HL,(NXTFILE)		;GET PTR TO NEXT FILE
	LD	A,(HL)		;ANY FILES?
	OR	A
	JP	Z,EXIT
	LD	A,(PRFLG)		;CHECK FOR LIST OUTPUT
	OR	A		;0=TYPE
	BRZ	TYPEX1
	LD	A,CR		;BOL ON PRINTER
	CALL	LCOUT
	LD	A,FF		;FORM FEED THE PRINTER
	CALL	LCOUT
	BR	TYPEX2
TYPEX1:
	CALL	PAGEBREAK	;PAGE BREAK MESSAGE
TYPEX2:
	LD	DE,FCB1+1	;COPY INTO FCB1
	LD	B,11		;11 BYTES
	CALL	LDIR
	LD	(NXTFILE),HL		;SET PTR TO NEXT FILE
	CALL	INITFCB1	;INIT FCB1
	LD	C,15		;OPEN FILE
	CALL	BDOS
	INC	A		;SET ERROR FLAG
	JP	Z,PRFNF		;ABORT IF ERROR
	LD	A,NLINES-2	;SET LINE COUNT
	LD	(PAGCNT),A
	LD	A,CR		;NEW LINE
	CALL	LCOUT
	LD	A,LF
	CALL	LCOUT
	LD	BC,080H		;SET CHAR POSITION AND TAB COUNT
				;  (B=0=TAB, C=080H=CHAR POSITION)
;
;  MAIN LOOP FOR LOADING NEXT BLOCK
;
TYPE2:
	LD	A,C		;GET CHAR COUNT
	CP	80H
	BRC	TYPE3
	PUSH	HL		;READ NEXT BLOCK
	PUSH	BC
	LD	DE,FCB1		;PT TO FCB
	LD	C,20		;READ RECORD
	CALL	BDOS
	OR	A		;SET FLAGS
	POP	BC
	POP	HL
	BRNZ	TYPE7		;END OF FILE?
	LD	C,0		;SET CHAR COUNT
	LD	HL,TBUFF		;PT TO FIRST CHAR
;
;  MAIN LOOP FOR PRINTING CHARS IN TBUFF
;
TYPE3:
	LD	A,(HL)		;GET NEXT CHAR
	AND	7FH		;MASK OUT MSB
	CP	1AH		;END OF FILE (^Z)?
	BRZ	TYPE7		;NEXT FILE IF SO
;
; OUTPUT CHAR TO CON: OR LST: DEVICE WITH TABULATION
;
	CP	CR		;RESET TAB COUNT?
	BRZ	TYPE4
	CP	LF		;RESET TAB COUNT?
	BRZ	TYPE4
	CP	TAB		;TAB?
	BRZ	TYPE5
;
;  OUTPUT CHAR AND INCREMENT CHAR COUNT
;
	CALL	LCOUT		;OUTPUT CHAR
	JP	Z,TYPEX		;SKIP
	INC	B		;INCREMENT TAB COUNT
	BR	TYPE6
;
;  OUTPUT <CR> OR <LF> AND RESET TAB COUNT
;
TYPE4:
	CALL	LCOUT		;OUTPUT <CR> OR <LF>
	JP	Z,TYPEX		;SKIP
	LD	B,0		;RESET TAB COUNTER
	BR	TYPE6
;
;  TABULATE
;
TYPE5:
	LD	A,' '		;<SP>
	CALL	LCOUT
	JP	Z,TYPEX		;SKIP
	INC	B		;INCR POS COUNT
	LD	A,B
	AND	7
	BRNZ	TYPE5
;
; CONTINUE PROCESSING
;
TYPE6:
	INC	C		;INCREMENT CHAR COUNT
	INC	HL		;PT TO NEXT CHAR
	CALL	BREAK		;CHECK FOR ABORT
	JP	Z,TYPEX		;SKIP
	BR	TYPE2
TYPE7:
	LD	DE,FCB1		;CLOSE FILE
	LD	C,16		;BDOS FUNCTION
	CALL	BDOS
	JP	TYPEX
;
; SEND OUTPUT TO LST: OR CON:, AS PER THE FLAG
;   RETURN WITH Z IF ABORT
;
LCOUT:
	PUSH	HL		;SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	E,A		;CHAR IN E
	LD	C,2		;OUTPUT TO CON:
PRFLG	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	LD	A,0		;2ND BYTE IS THE PRINT FLAG
	OR	A		;0=TYPE
	BRZ	LC1
	LD	C,5		;OUTPUT TO LST:
LC1:
	PUSH	DE		;SAVE CHAR
	CALL	BDOS		;OUTPUT CHAR IN E
	POP	DE		;GET CHAR
	LD	A,E
	CP	LF
	BRNZ	LC2
	LD	A,(PRFLG)		;OUTPUT TO LST:?
	OR	A		;NZ = YES
	BRNZ	LC2
;
; CHECK FOR PAGING
;
	LD	HL,PAGCNT	;COUNT DOWN
	DEC	(HL)
	BRNZ	LC2		;JUMP IF NOT END OF PAUSE
	LD	(HL),NLINES-2	;REFILL COUNTER
PGFLG	EQU	$+1		;POINTER TO IN-THE-CODE BUFFER
	LD	A,0		;2ND BYTE IS THE PAGING FLAG
	CP	PGDFLG		;PAGE DEFAULT OVERRIDE OPTION WANTED?
;
	IF	PGDFLT		;IF PAGING IS DEFAULT
;
	BRZ	LC2		;PGDFLG MEANS NO PAGING
;
	ELSE
;
	BRNZ	LC2		;PGDFLG MEANS PAGE
;
	ENDIF		;PGDFLT
;
	CALL	PAGEBREAK	;PRINT PAGE BREAK MESSAGE
	BR	LC3		;Z TO SKIP
LC2:
	XOR	A		;SET OK
	DEC	A		;NZ=OK
LC3:
	POP	BC		;RESTORE REGS
	POP	DE
	POP	HL
	RET
;
; PRINT PAGE BREAK MESSAGE AND GET USER INPUT
;   ABORT IF ^C, RZ IF ^X
;
PAGEBREAK:
	PUSH	HL		;SAVE HL
	CALL	PRINT
	DB	CR,LF,' Typing',' '+80H
	LD	HL,FCB1+1	;PRINT FILE NAME
	CALL	PRFN
	CALL	DASH		;PRINT DASH
	CALL	CONIN		;GET INPUT
	POP	HL		;RESTORE HL
	PUSH	AF
	CALL	CRLF		;NEW LINE
	POP	AF
	CP	CTRLC		;^C
	JP	Z,EXIT
	CP	CTRLX		;SKIP?
	RET
;
	ENDIF		;LTON
;
;Section 5E
;Command: REN
;Function:  To change the name of an existing file
;Forms:
;	REN <New ufn>=<Old ufn>	Perform function
;
	IF	RENON
REN:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
	IF	WREN
	CALL	WHLTST
	ENDIF		;WHEEL APPROVAL
;
	CALL	RETSAVE
;
;
; STEP 1:  CHECK FOR FILE 2 BEING AMBIGUOUS
;
	LD	HL,FCB2+1	;CAN'T BE AMBIGUOUS
	CALL	AMBCHK1
;
; STEP 2:  LOG INTO USER AREA
;
	CALL	LOGUSR		;LOG INTO USER AREA OF FCB1
;
; STEP 3:  SEE IF NEW FILE ALREADY EXISTS
;   EXTEST PERFORMS A NUMBER OF CHECKS:
;     1) AMBIGUITY
;     2) R/O
;     3) IF FILE EXISTS AND NOT R/O, PERMISSION TO DELETE
;
	CALL	EXTEST
	JP	Z,EXIT		;R/O OR NO PERMISSION
;
; STEP 4:  EXCHANGE FILE NAME FIELDS FOR RENAME
;
	LD	HL,FCB1		;EXCHANGE NAMES ONLY
	PUSH	HL		;SAVE PTR
	INC	HL
	LD	DE,FCB2+1
	LD	B,11		;11 BYTES
REN1:
	LD	A,(DE)		;GET OLD
	LD	C,A
	LD	A,(HL)
	LD	(DE),A		;PUT NEW
	LD	(HL),C
	INC	HL		;PT TO NEXT
	INC	DE
	DBNZ	REN1
;
; STEP 5:  SEE IF OLD FILE IS R/O
;
	CALL	SEARF		;LOOK FOR FILE
	JP	Z,PRFNF
	CALL	GETSBIT		;GET PTR TO ENTRY IN TBUFF
	EX	DE,HL			;HL PTS TO ENTRY
	INC	HL		;PT TO FN
	CALL	ROTEST		;SEE IF FILE IS R/O
	JP	NZ,EXIT
;
; STEP 6:  RENAME THE FILE
;
	POP	DE		;GET PTR TO FCB
	LD	C,23		;RENAME
	CALL	BDOS
	INC	A		;SET ZERO FLAG IF ERROR
	JP	Z,PRFNF		;PRINT NO SOURCE FILE MESSAGE
	JP	EXIT
;
	ENDIF		;RENON
;
;Section 5F
;Command: PROT
;Function:  To set the attributes of a file (R/O and SYS)
;
;Form:
;	PROT afn RSI
;If either R or S are omitted, the file is made R/W or DIR, resp;
;R and S may be in any order.  If I is present, Inspection is enabled.
;
	IF	PROTON
ATT:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
	IF	WPROT
	CALL	WHLTST
	ENDIF		;WHEEL APPROVAL
;
	CALL	RETSAVE
	XOR	A		;SET NO INSPECT
	LD	(INSPECT),A
	LD	HL,0		;SET R/O AND SYS ATTRIBUTES OFF
	LD	DE,FCB2+1	;PT TO ATTRIBUTES
	LD	B,3		;3 CHARS MAX
ATT1:
	LD	A,(DE)		;GET CHAR
	INC	DE		;PT TO NEXT
	CP	'I'		;INSPECT?
	BRZ	ATTI
	CP	'R'		;SET R/O?
	BRZ	ATTR
	CP	'S'		;SET SYS?
	BRZ	ATTS
ATT2:
	DBNZ	ATT1
	BR	ATT3
ATTI:
	LD	(INSPECT),A		;SET FLAG
	BR	ATT2
ATTR:
	LD	H,80H		;SET R/O BIT
	BR	ATT2
ATTS:
	LD	L,80H		;SET SYS BIT
	BR	ATT2
ATT3:
	LD	(FATT),HL		;SAVE FILE ATTRIBUTES
	LD	A,1		;SELECT DIR AND SYS FILES
	CALL	GETDIR		;LOAD DIRECTORY
	JP	Z,PRFNF		;NO FILE ERROR
	LD	(NXTFILE),HL		;PT TO NEXT FILE
	BR	ATT5
ATT4:
	LD	HL,(NXTFILE)		;PT TO NEXT FILE
	LD	A,(HL)		;END OF LIST?
	OR	A
	JP	Z,EXIT
	CALL	CRLF		;NEW LINE
ATT5:
	PUSH	HL		;SAVE PTR TO CURRENT FILE
	CALL	PRFN		;PRINT ITS NAME
	LD	(NXTFILE),HL		;SAVE PTR TO NEXT FILE
	CALL	PRINT
	DB	' Set to R','/'+80H
	LD	HL,(FATT)		;GET ATTRIBUTES
	LD	C,'W'		;ASSUME R/W
	LD	A,H		;GET R/O BIT
	OR	A
	BRZ	ATT6
	LD	C,'O'		;SET R/O
ATT6:
	LD	A,C		;GET CHAR
	CALL	CONOUT
	LD	A,L		;GET SYS FLAG
	OR	A		;SET FLAG
	BRZ	ATT7
	CALL	PRINT
	DB	' and SY','S'+80H
ATT7:
INSPECT	EQU	$+1		;PTR FOR IN-THE-CODE MODIFICATION
	LD	A,0		;GET INSPECT FLAG
	OR	A		;Z=NO
	POP	HL		;GET PTR TO CURRENT FILE
	BRZ	ATT8
	CALL	ERAQ1		;ASK FOR Y/N
	BRNZ	ATT4		;ADVANCE TO NEXT FILE IF NOT Y
ATT8:
	LD	DE,FCB1+1	;COPY INTO FCB1
	LD	B,11		;11 BYTES
	CALL	LDIR
FATT	EQU	$+1		;PTR FOR IN-THE-CODE MODIFICATION
	LD	HL,0		;GET ATTRIBUTES
	DEC	DE		;PT TO SYS BYTE
	DEC	DE
	LD	A,L		;GET SYS FLAG
	CALL	ATTSET		;SET ATTRIBUTE CORRECTLY
	DEC	DE		;PT TO R/O BYTE
	LD	A,H		;GET R/O FLAG
	CALL	ATTSET
	LD	DE,FCB1		;PT TO FCB
	LD	C,30		;SET ATTRIBUTES
	CALL	BDOS
	BR	ATT4
ATTSET:
	OR	A		;0=CLEAR ATTRIBUTE
	BRZ	ATTST1
	LD	A,(DE)		;GET BYTE
	OR	80H		;SET ATTRIBUTE
	LD	(DE),A
	RET
ATTST1:
	LD	A,(DE)		;GET BYTE
	AND	7FH		;CLEAR ATTRIBUTE
	LD	(DE),A
	RET
;
	ENDIF		;PROTON
;
;Section 5G
;Command: CP
;Function:  To copy a file from one place to another
;
;Form:
;	CP new=old
;
	IF	CPON

	IF	COPYTOP		;<JPS> IF USING TOP OF TPA AS COPY BUFFER
CBUFF	DS	2		;<JPS> SPACE TO SAVE ADDRESS OF COPY BUFFER
	ENDIF	;COPYTOP

COPY:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
	IF	WCP
	CALL	WHLTST
	ENDIF		;WHEEL APPROVAL
;
	CALL	RETSAVE
;
; STEP 0:  IF NEW IS BLANK, MAKE IT THE SAME NAME AND TYPE AS OLD
;
	LD	DE,FCB1+1	;PT TO NEW FILE NAME
	LD	A,(DE)		;GET FIRST CHAR
	CP	' '		;NO NAME?
	BRNZ	COPY0
	LD	HL,FCB2+1	;MAKE SAME AS OLD
	LD	B,11		;11 BYTES
	CALL	LDIR
;
; STEP 1:  SEE IF NEW=OLD AND ABORT IF SO
;
COPY0:
	LD	HL,FCB1		;PT TO NEXT
	LD	DE,FCB2		;PT TO OLD
	PUSH	HL		;SAVE PTRS
	PUSH	DE
	INC	HL		;PT TO FILE NAME
	INC	DE
	LD	B,13		;COMPARE 13 BYTES
COPY1:
	LD	A,(DE)		;GET OLD
	CP	(HL)		;COMPARE TO NEW
	BRNZ	COPY2
	INC	HL		;PT TO NEXT
	INC	DE
	DBNZ	COPY1
	LD	C,25		;GET CURRENT DISK
	CALL	BDOS
	INC	A		;MAKE 1..P
	LD	B,A		;CURRENT DISK IN B
	POP	DE		;GET PTR TO DN
	POP	HL
	LD	A,(DE)		;GET DISK
	LD	C,A		;... IN C
	OR	A		;CURRENT?
	BRNZ	COPY1A
	LD	C,B		;MAKE C CURRENT
COPY1A:
	LD	A,(HL)		;GET DISK
	OR	A		;CURRENT?
	BRNZ	COPY1B
	LD	A,B		;MAKE A CURRENT
COPY1B:
	CP	C		;SAME DISK ALSO?
	BRNZ	COPY3		;CONTINUE WITH OPERATION
	BR	CPERR
COPY2:
	POP	DE		;GET PTRS
	POP	HL
;
; STEP 2:  SET USER NUMBERS
;
COPY3:
	LD	A,(FCB1+13)		;GET NEW USER
	LD	(USRNEW),A
	LD	A,(FCB2+13)		;GET OLD USER
	LD	(USROLD),A
;
; STEP 3:  SEE IF OLD FILE EXISTS
;
	LD	HL,OLDFCB	;COPY OLD INTO 2ND FCB
	PUSH	HL		;SAVE PTR TO 2ND FCB
	EX	DE,HL
	LD	B,14		;14 BYTES
	CALL	LDIR
	CALL	LOGOLD		;LOG IN USER NUMBER OF OLD FCB
	POP	HL		;GET PTR TO 2ND FCB
	CALL	INITFCB2	;INIT FCB
	LD	C,17		;LOOK FOR FILE
	CALL	BDOS
	INC	A		;CHECK FOR ERROR
	JP	Z,PRFNF		;FILE NOT FOUND
;
; STEP 4:  SEE IF NEW EXISTS
;
	CALL	LOGNEW		;LOG INTO NEW'S USER AREA
	CALL	EXTEST		;TEST
	JP	Z,EXIT		;ERROR EXIT
;
; STEP 5:  CREATE NEW
;
	LD	DE,FCB1		;PT TO FCB
	LD	C,22		;MAKE FILE
	CALL	BDOS
	INC	A		;ERROR?
	BRNZ	COPY4
;
; COPY ERROR
;
CPERR:
	CALL	PRINT
	DB	' Copy','?'+80H
	JP	EXIT
;
; STEP 6:  OPEN OLD
;
COPY4:
	CALL	LOGOLD		;GET USER
	LD	HL,OLDFCB	;PT TO FCB
	CALL	INITFCB2	;INIT FCB
	LD	C,15		;OPEN FILE
	CALL	BDOS
;
; STEP 7:  COPY OLD TO NEW WITH BUFFERING
;
COPY5:
	CALL	LOGOLD		;GET USER
	LD	B,0		;SET COUNTER
;<JPS>	LXI	H,TPA		;SET NEXT ADDRESS TO COPY INTO

		;<JPS> NEW CODE TO USE TOP OF TPA AS COPY BUFFER
	 IF	COPYTOP
	LD	HL,(BDOS+1)				;GET BOTTOM OF BDOS
	LD	DE,-[CPBLOCKS*128 + 806H]	;SAVE CCP AND BUFFER SPACE
	ADD	HL,DE				;ADDR OF BOTTOM OF COPY BUFFER
	LD	(CBUFF),HL
	 ELSE	;NOT COPYTOP
	LD	HL,TPA
	 ENDIF	;COPYTOP
		;<JPS> END OF NEW CODE BLOCK

COPY5A:
	PUSH	HL		;SAVE ADDRESS AND COUNTER
	PUSH	BC
	LD	DE,OLDFCB	;READ BLOCK FROM FILE
	LD	C,20
	CALL	BDOS
	POP	BC		;GET COUNTER AND ADDRESS
	POP	DE
	OR	A		;OK?
	BRNZ	COPY5B
	PUSH	BC		;SAVE COUNTER
	LD	HL,TBUFF		;COPY FROM BUFFER
	LD	B,128		;128 BYTES
	CALL	LDIR
	EX	DE,HL			;HL PTS TO NEXT
	POP	BC		;GET COUNTER
	INC	B		;INCREMENT IT
	LD	A,B		;DONE?
	CP	CPBLOCKS	;DONE IF CPBLOCKS LOADED
	BRNZ	COPY5A
COPY5B:
	LD	A,B		;GET COUNT
	OR	A
	BRZ	COPY6		;DONE IF NOTHING LOADED
	PUSH	BC		;SAVE COUNT
	CALL	LOGNEW		;GET USER
;<JPS>	LXI	H,TPA		;PT TO TPA
	 IF	COPYTOP		;<JPS>
	LD	HL,(CBUFF)		;<JPS>
	 ELSE	;NOT COPYTOP	;<JPS>
	LD	HL,TPA		;<JPS>
	 ENDIF	;COPYTOP	;<JPS>
COPY5C:
	LD	DE,TBUFF		;COPY INTO TBUFF
	LD	B,128		;128 BYTES
	CALL	LDIR
	PUSH	HL		;SAVE PTR TO NEXT
	LD	DE,FCB1		;PT TO FCB
	LD	C,21		;WRITE BLOCK
	CALL	BDOS
	OR	A
	BRNZ	CPERR		;COPY ERROR
	POP	HL		;GET PTR TO NEXT BLOCK
	POP	BC		;GET COUNT
	DEC	B		;COUNT DOWN
	BRZ	COPY5		;GET NEXT
	PUSH	BC		;SAVE COUNT
	BR	COPY5C
;
; STEP 8:  CLOSE FILES
;
COPY6:
	CALL	LOGOLD		;GET USER
	LD	DE,OLDFCB	;PT TO FCB
	LD	C,16		;CLOSE FILE
	CALL	BDOS
	CALL	LOGNEW		;GET USER
	LD	DE,FCB1		;PT TO FCB
	LD	C,16		;CLOSE FILE
	CALL	BDOS
	CALL	PRINT
	DB	' Don','e'+80H
	JP	EXIT
;
; LOG INTO USER NUMBER OF OLD FILE
;
LOGOLD:
USROLD	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	LD	A,0		;GET NUMBER
	JP	SETUSR
;
; LOG INTO USER NUMBER OF NEW FILE
;
LOGNEW:
USRNEW	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	LD	A,0		;GET NUMBER
	JP	SETUSR
;
	ENDIF		;CPON
;
;Section 5H
;Command: PEEK
;Function:  Display memory
;
;Form:
;	PEEK startadr		- 256 bytes displayed
;	PEEK startadr endadr	- range of bytes displayed
;
	IF	PEEKON
PEEK:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
	IF	WPEEK
	CALL	WHLTST
	ENDIF		;WHEEL APPROVAL
;
	CALL	RETSAVE
	LD	HL,TBUFF+1	;FIND FIRST NUMBER
NXTPEEK	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	LD	DE,0		;DEFAULT PEEK ADDRESS IF NONE
	CALL	SKSP		;SKIP TO NON-BLANK
	CALL	NZ,HEXNUM		;GET START ADDRESS IF ANY (ELSE DEFAULT)
	CALL	PRINT
	DB	' Pee','k'+80H
	CALL	ADRAT		;PRINT ADDRESS MESSAGE
	PUSH	DE		;SAVE IT
	LD	BC,255		;COMPUTE END ADDRESS
	EX	DE,HL
	ADD	HL,BC

	 IF	PEEKCHK		;<JPS> CHECK FOR OVERFLOW
	BRNC	PEEK0		;IF NO OVERFLOW PAST FFFF, GO ON
	LD	HL,0FFFFH	;ELSE USE FFFF AS ENDING ADDRESS
PEEK0:
	 ENDIF

	EX	DE,HL			;END ADDRESS IN DE
	CALL	SKSP		;SKIP TO NON-BLANK
	BRZ	PEEK1		;PROCESS
	CALL	HEXNUM		;GET 2ND NUMBER IN DE
PEEK1:
	POP	HL		;HL IS START ADDRESS, DE IS END ADDRESS
	LD	C,0FFH		;USE C AS CONTINUE FLAG <JPS>
	CALL	PEEK2		;DO PEEK
	LD	(NXTPEEK),HL		;SET CONTINUED PEEK ADDRESS
	JP	EXIT
;
; DISPLAY LOOP
;
PEEK2:
;	MOV	A,D		;SEE IF DE<=HL
;	CMP	H
;	RC			;OUT OF BOUNDS
;	BRNZ	PEEK2A		;HL > DE
;	MOV	A,E
;	CMP	L
;	RZ
;	RC

	LD	A,C		;CHECK CONTINUATION FLAG <JPS>
	OR	A		;<JPS>
	RET	Z			;<JPS>

		;PRINT LINE HEADER

PEEK2A:
	CALL	CRLF		;NEW LINE
	LD	A,H		;PRINT ADDRESS
	CALL	PASHC
	LD	A,L
	CALL	PAHC
	CALL	DASH		;PRINT LEADER
	LD	B,16		;16 BYTES TO DISPLAY
	PUSH	HL		;SAVE START ADDRESS

		;PRINT HEX VALUES FOR 16 BYTES

PEEK3:
	LD	A,(HL)		;GET NEXT BYTE
	CALL	PASHC		;PRINT WITH LEADING SPACE

				;CHECK FOR LAST ADDRESS <JPS>
				;IF C IS ALREADY 0, LEAVE IT THAT WAY.
				;OTHERWISE CHECK FOR END ADDRESS AND IF SO
				;SET C TO ZERO.

	LD	A,C		;SEE IF CONTINUE FLAG ALREADY CLEARED
	OR	A
	BRZ	PEEK3A		;IF SO, SKIP TEST
	LD	A,H
	SUB	D		;SEE IF H = D
	LD	C,A
	LD	A,L
	SUB	E		;SEE IF L = E
	OR	C		;COMBINE TWO TESTS
	LD	C,A

PEEK3A:	INC	HL		;PT TO NEXT
	DBNZ	PEEK3

		;PRINT ASCII EQUIVALENTS FOR 16 BYTES

	POP	HL		;PT TO FIRST ADDRESS AGAIN
	LD	B,16		;16 BYTES
	LD	A,' '		;SPACE AND FENCE
	CALL	CONOUT
	CALL	PRINT
	DB	FENCE+80H
	PUSH	BC		;SAVE FLAG IN C
PEEK4:
	LD	A,(HL)		;GET NEXT BYTE
	LD	C,'.'		;ASSUME DOT
	AND	7FH		;MASK IT
	CP	' '		;DOT IF LESS THAN SPACE
	BRC	PEEK5
	CP	7FH		;DON'T PRINT DEL
	BRZ	PEEK5
	LD	C,A		;CHAR IN C
PEEK5:
	LD	A,C		;GET CHAR
	CALL	CONOUT		;SEND IT
	INC	HL		;PT TO NEXT
	DBNZ	PEEK4

	CALL	PRINT		;CLOSING FENCE
	DB	FENCE+80H
	POP	BC		;GET FLAG IN C BACK
	CALL	BREAK		;ALLOW ABORT
	BR	PEEK2
;
	ENDIF		;PEEKON
;
; PRINT A AS 2 HEX CHARS
;   PASHC - LEADING SPACE
;
	IF	PEEKON OR POKEON
PASHC:
	PUSH	AF		;SAVE A
	CALL	PRINT
	DB	' '+80H
	POP	AF
PAHC:
	PUSH	BC		;SAVE BC
	LD	C,A		;BYTE IN C
	RRCA			;EXCHANGE NYBBLES
	RRCA
	RRCA
	RRCA
	CALL	PAH		;PRINT HEX CHAR
	LD	A,C		;GET LOW
	POP	BC		;RESTORE BC AND FALL THRU TO PAH
PAH:
	AND	0FH		;MASK
	ADD	'0'		;CONVERT TO ASCII
	CP	'9'+1		;LETTER?
	BRC	PAH1
	ADD	7		;ADJUST TO LETTER
PAH1:
	JP	CONOUT
;
	ENDIF		;PEEKON OR POKEON
;
;Section 5I
;Command: POKE
;Function:  Place Values into Memory
;
;Form:
;	POKE startadr val1 val2 ...
;
	IF	POKEON
POKE:
;
; CHECK FOR WHEEL APPROVAL IF OPTION ENABLED
;
	IF	WPOKE
	CALL	WHLTST
	ENDIF		;WHEEL APPROVAL
;
	CALL	RETSAVE
	LD	HL,TBUFF+1	;PT TO FIRST CHAR
	CALL	SKSP		;SKIP TO NON-BLANK
	BRZ	NOARGS		;ARG ERROR
	CALL	HEXNUM		;CONVERT TO NUMBER
	CALL	PRINT
	DB	' Pok','e'+80H
	CALL	ADRAT		;PRINT AT MESSAGE
;
; LOOP FOR STORING HEX VALUES SEQUENTIALLY VIA POKE
;
POKE1:
	PUSH	DE		;SAVE ADDRESS
	CALL	SKSP		;SKIP TO NON-BLANK
	JP	Z,EXIT		;DONE
	CP	'"'		;QUOTED TEXT?
	BRZ	POKE2
	CALL	HEXNUM		;GET NUMBER
	LD	A,E		;GET LOW
	POP	DE		;GET ADDRESS
	LD	(DE),A		;STORE NUMBER
	INC	DE		;PT TO NEXT
	BR	POKE1
;
; STORE ASCII CHARS
;
POKE2:
	POP	DE		;GET NEXT ADDRESS
	INC	HL		;PT TO NEXT CHAR
POKE3:
	LD	A,(HL)		;GET NEXT CHAR
	OR	A		;DONE?
	JP	Z,EXIT
	LD	(DE),A		;PUT CHAR
	INC	HL		;PT TO NEXT
	INC	DE
	BR	POKE3
;
; No Argument Error
;
NOARGS:
	CALL	PRINT
	DB	' Arg','?'+80H
	JP	EXIT
;
	ENDIF		;POKEON
;
;Section 5J
;Command: REG
;Function:  Manipulate Memory Registers
;
;Forms:
;	REG D or REG		<-- Display Register Value
;	REG Mreg		<-- Decrement Register Value
;	REG Preg		<-- Increment Register Value
;	REG Sreg value		<-- Set Register Value
;
	IF	REGON
REGISTER:
	IF	WREG		;IF WHEEL CHECK <JPS>
	CALL	WHLTST
	ENDIF	;WREG

	LD	HL,FCB1+1	;PT TO FIRST ARG
	LD	A,(HL)		;GET FIRST CHAR
	PUSH	AF		;SAVE CHAR
	CP	'A'		;ASSUME DIGIT IF LESS THAN 'A'
	BRC	REGC1
	INC	HL		;PT TO DIGIT
REGC1:
	LD	A,(HL)		;GET DIGIT
	CALL	REGPTR		;PT TO REGISTER
	POP	AF		;GET CHAR
	CP	'S'		;SET?
	BRZ	RSET
	CP	'P'		;PLUS?
	BRZ	RINC
	CP	'M'		;MINUS?
	BRZ	RDEC
;
; SHOW REGISTER VALUES
;
RSHOW:
	XOR	A		;SELECT REGISTER 0
	LD	B,A		;COUNTER SET TO 0 IN B
	CALL	REGP2		;HL PTS TO REGISTER 0
RSHOW1:
	LD	A,B		;GET COUNTER VALUE
	CP	10
	JP	Z,CRLF		;NEW LINE AND EXIT IF DONE
	CALL	PRINT
	DB	'  Reg',' '+80H
	LD	A,B		;PRINT REGISTER NUMBER
	ADD	'0'
	CALL	CONOUT
	CALL	PRINT
	DB	' ','='+80H
	PUSH	BC		;SAVE COUNTER
	CALL	REGOUT		;PRINT REGISTER VALUE
	POP	BC		;GET COUNTER
	INC	B		;INCREMENT COUNTER
	LD	A,B		;CHECK FOR NEW LINE
	AND	3
	CALL	Z,CRLF
	INC	HL		;PT TO NEXT REGISTER
	BR	RSHOW1
;
; INCREMENT REGISTER VALUE
;	HL PTS TO MEMORY REGISTER ON INPUT
;
RINC:
	INC	(HL)	;INCREMENT IT
	BR	REGOUT	;PRINT RESULT
;
; DECREMENT REGISTER VALUE
;	HL PTS TO MEMORY REGISTER ON INPUT
;
RDEC:
	DEC	(HL)	;DECREMENT VALUE
	BR	REGOUT	;PRINT RESULT
;
; SET REGISTER VALUE
;	HL PTS TO REGISTER ON INPUT
;
RSET:
	LD	DE,FCB2+1	;PT TO VALUE
	LD	B,0	;INIT VALUE TO ZERO
RSET1:
	LD	A,(DE)	;GET NEXT DIGIT
	INC	DE	;PT TO NEXT
	SUB	'0'	;CONVERT TO BINARY
	BRC	RSET2
	CP	10	;RANGE?
	BRNC	RSET2
	LD	C,A	;DIGIT IN C
	LD	A,B	;MULTIPLY OLD BY 10
	ADD	A,A	;*2
	ADD	A,A	;*4
	ADD	A,B	;*5
	ADD	A,A	;*10
	ADD	A,C	;ADD IN NEW DIGIT
	LD	B,A	;RESULT IN B
	BR	RSET1
RSET2:
	LD	(HL),B	;SET VALUE
REGOUT:
	CALL	PRINT	;PRINT LEADING SPACE
	DB	' '+80H
	LD	A,(HL)	;GET REGISTER VALUE
	LD	B,100	;PRINT 100'S
	LD	C,0	;SET LEADING SPACE FLAG
	CALL	DECB	;PRINT 100'S
	LD	B,10	;PRINT 10'S
	CALL	DECB	;PRINT 10'S
	ADD	'0'	;PRINT 1'S
	JP	CONOUT
;
; SUBTRACT B FROM A UNTIL CARRY, THEN PRINT DIGIT COUNT
;
DECB:
	LD	D,'0'	;SET DIGIT
DECB1:
	SUB	B	;SUBTRACT
	BRC	DECB2
	INC	D	;ADD 1 TO DIGIT CHAR
	BR	DECB1
DECB2:
	ADD	A,B	;ADD BACK IN
	LD	E,A	;SAVE A IN E
	LD	A,D	;GET DIGIT CHAR
	CP	'0'	;LEADING ZERO CHECK
	BRNZ	DECB3
	LD	A,C	;ANY LEADING DIGIT YET?
	OR	A
	BRZ	DECB4
DECB3:
	LD	A,D	;GET DIGIT CHAR
	CALL	CONOUT	;PRINT IT
	INC	C	;SET C<>0 FOR LEADING DIGIT CHECK
DECB4:
	LD	A,E	;RESTORE A FOR NEXT ROUND
	RET

;
; SET HL TO POINT TO MEMORY REGISTER WHOSE INDEX IS PTED TO BY HL
;	ON INPUT, A CONTAINS REGISTER CHAR
;	ON OUTPUT, HL = ADDRESS OF MEMORY REGISTER (REG 0 ASSUMED IF ERROR)
;
REGPTR:
	LD	B,0	;INIT TO ZERO
	SUB	'0'	;CONVERT
	BRC	REGP1
	CP	10	;RANGE
	BRNC	REGP1
	LD	B,A	;VALUE IN B
REGP1:
	LD	A,B	;VALUE IN A
REGP2:
	LD	HL,Z3MSG+30H	;PT TO MEMORY REGISTERS
	ADD	A,L	;PT TO PROPER REGISTER
	LD	L,A
	LD	A,H
	ADC	0
	LD	H,A	;HL PTS TO REGISTER
	RET
;
	ENDIF		;REGON

;
;Section 5K
;Command: WHL/WHLQ
;Function:  Set the Wheel Byte on or off
;
;If WHLQUIET equate is true, then RCP does not report wheel status with WHL
;command.
;
;Form:
;	WHL		-- turn Wheel Byte OFF
;	WHL password	-- turn Wheel Byte ON if password is correct
;	WHLQ		-- find out status of Wheel Byte
;
	IF	WHLON
WHL:
	LD	HL,FCB1+1	;PT TO FIRST CHAR
	LD	A,(HL)	;GET IT
	CP	' '	;TURN BYTE OFF IF NO PASSWORD
	BRZ	WHLOFF
	LD	DE,WHLPASS
	LD	B,8	;CHECK 8 CHARS
WHL1:
	LD	A,(DE)	;GET CHAR
	CP	(HL)	;COMPARE
	BRNZ	WHLMSG
	INC	HL	;PT TO NEXT
	INC	DE
	DBNZ	WHL1
;
; TURN ON WHEEL BYTE
;
	LD	A,0FFH	;TURN ON WHEEL BYTE
	BR	WHLSET
;
; TURN OFF WHEEL BYTE
;
WHLOFF:
	XOR	A	;TURN OFF WHEEL BYTE
WHLSET:
	LD	(Z3WHL),A	;SET WHEEL BYTE AND PRINT MESSAGE
	IF	WHLQUIET
	RET
	ENDIF
;
; PRINT WHEEL BYTE MESSAGE
;
WHLMSG:
	CALL	PRINT
	DB	' Wheel Byte',' '+80H
	LD	A,(Z3WHL)	;GET WHEEL BYTE
	OR	A	;ZERO IS OFF
	BRZ	OFFM
	CALL	PRINT
	DB	'O','N'+80H
	RET
OFFM:
	CALL	PRINT
	DB	'OF','F'+80H
	RET
;
; WHEEL PASSWORD DEFINED FROM SYSRCP.LIB FILE
;
	DB	'Z'-'@'	;LEADING ^Z IN CASE OF TYPE
WHLPASS:
	WPASS		;USE MACRO
;
	ENDIF		;WHLON

;
;Section 5L
;Command: ECHO
;Function:  Echo Text without Interpretation to Console or Printer
;
;Form:
;	ECHO text		<-- echo text to console
;	ECHO $text		<-- echo text to printer
;
;	Additionally, if a form feed character is encountered in the
; output string, no further output will be done, a new line will be
; issued, and this will be followed by a form feed character.  That is:
;
;		ECHO $text^L
;
; will cause "text" to be printed on the printer followed by CR, LF, FF.
;
ECHO:
	LD	HL,TBUFF+1	;PT TO FIRST CHAR
ECHO1:
	LD	A,(HL)		;SKIP LEADING SPACES
	INC	HL		;PT TO NEXT
	CP	' '
	BRZ	ECHO1
;
	IF	ECHOLST
	LD	B,A		;CHAR IN B
	CP	'$'		;PRINT FLAG?
	BRZ	ECHO2
	ENDIF		;ECHOLST
;
	DEC	HL		;PT TO CHAR
;
; LOOP TO ECHO CHARS
;
ECHO2:
	LD	A,(HL)		;GET CHAR
	OR	A		;EOL?
	BRZ	ECHO4
;
	IF	ECHOLST
	CP	FF		;FORM FEED?
	BRZ	ECHO3
	ENDIF		;ECHOLST
;
ECHO2C:
	CALL	ECHOUT		;SEND CHAR
	INC	HL		;PT TO NEXT
	BR	ECHO2
;
; FORM FEED - SEND NEW LINE FOLLOWED BY FORM FEED IF PRINTER OUTPUT
;
	IF	ECHOLST
ECHO3:
	LD	A,B		;CHECK FOR PRINTER OUTPUT
	CP	'$'
	BRNZ	ECHOFF		;SEND FORM FEED NORMALLY IF NOT PRINTER
	CALL	ECHONL		;SEND NEW LINE
	LD	A,FF		;SEND FORM FEED
	BR	ECHOUT
;
; SEND FORM FEED CHAR TO CONSOLE
;
ECHOFF:
	LD	A,FF		;GET CHAR
	BR	ECHO2C
	ENDIF		;ECHOLST
;
; END OF PRINT LOOP - CHECK FOR PRINTER TERMINATION
;
ECHO4:
	IF	NOT ECHOLST
;
	RET
;
	ELSE
;
	LD	A,B		;CHECK FOR PRINTER OUTPUT
	CP	'$'
	RET	NZ			;DONE IF NO PRINTER OUTPUT
;
; OUTPUT A NEW LINE
;
ECHONL:
	LD	A,CR		;OUTPUT NEW LINE ON PRINTER
	CALL	ECHOUT
	LD	A,LF		;FALL THRU TO ECHOUT
;
	ENDIF		;NOT ECHOLST
;
; OUTPUT CHAR TO PRINTER OR CONSOLE
;
ECHOUT:
	LD	C,A		;CHAR IN C
	PUSH	HL		;SAVE HL
	PUSH	BC		;SAVE BC
	LD	DE,0CH-3		;OFFSET FOR CONSOLE OUTPUT
;
	IF	ECHOLST
	LD	A,B		;CHECK FOR PRINTER
	CP	'$'
	BRNZ	ECHOUT1
	INC	DE		;ADD 3 FOR PRINTER OFFSET
	INC	DE
	INC	DE
;
	ENDIF		;ECHOLST
;
; OUTPUT CHAR IN C WITH BIOS OFFSET IN DE
;
ECHOUT1:
	CALL	BIOUT		;BIOS OUTPUT
	POP	BC		;RESTORE BC,HL
	POP	HL
	RET

;
; OUTPUT CHAR IN C TO BIOS WITH OFFSET IN DE
;
BIOUT:
	LD	HL,(WBOOT+1)		;GET ADDRESS OF WARM BOOT
	ADD	HL,DE		;PT TO ROUTINE
	JP	(HL)			;JUMP TO IT

;
;  ** SUPPORT UTILITIES **
;

;
;  CHECK FOR USER INPUT; IF ^C, RETURN WITH Z
;
BREAK:
	PUSH	HL		;SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	E,0FFH		;GET CHAR IF ANY
	LD	C,6		;CONSOLE STATUS CHECK
	CALL	BDOS
	POP	BC		;RESTORE REGS
	POP	DE
	POP	HL
	CP	CTRLC		;CHECK FOR ABORT
	JP	Z,EXIT		;EXIT
	CP	CTRLX		;SKIP?
	RET

;
; COPY HL TO DE FOR B BYTES
;
LDIR:
	LD	A,(HL)	;GET
	LD	(DE),A	;PUT
	INC	HL	;PT TO NEXT
	INC	DE
	DBNZ	LDIR	;LOOP
	RET

;
;  PRINT FILE NOT FOUND MESSAGE
;
PRFNF:
	CALL	PRINT
	DB	' No File','s'+80H
	JP	EXIT

;
;  OUTPUT NEW LINE TO CON:
;
CRLF:
	LD	A,CR
	CALL	CONOUT
	LD	A,LF
	JP	CONOUT

;
; SEARCH FOR FIRST AND NEXT
;
SEARF:
	PUSH	BC	; SAVE COUNTER
	PUSH	HL	; SAVE HL
	LD	C,17	; SEARCH FOR FIRST FUNCTION
SEARF1:
	LD	DE,FCB1	; PT TO FCB
	CALL	BDOS
	INC	A	; SET ZERO FLAG FOR ERROR RETURN
	POP	HL	; GET HL
	POP	BC	; GET COUNTER
	RET
SEARN:
	PUSH	BC	; SAVE COUNTER
	PUSH	HL	; SAVE HL
	LD	C,18	; SEARCH FOR NEXT FUNCTION
	BR	SEARF1

;
; CONSOLE INPUT
;
CONIN:
	PUSH	HL	; SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	C,1	; INPUT
	CALL	BDOS
	POP	BC	; GET REGS
	POP	DE
	POP	HL
	AND	7FH	; MASK MSB
	CP	61H
	RET	C
	AND	5FH	; TO UPPER CASE
	RET

;
; LOG INTO USER AREA CONTAINED IN FCB1
;
LOGUSR:
	LD	A,(FCB1+13)		;GET USER NUMBER
SETUSR:
	LD	E,A
	LD	C,32		;USE BDOS FCT
	JP	BDOS

;
;  PRINT FILE NAME PTED TO BY HL
;
PRFN:
	CALL	PRINT	;LEADING SPACE
	DB	' '+80H
	LD	B,8	;8 CHARS
	CALL	PRFN1
	LD	A,'.'	;DOT
	CALL	CONOUT
	LD	B,3	;3 CHARS
PRFN1:
	LD	A,(HL)	; GET CHAR
	INC	HL	; PT TO NEXT
	CALL	CONOUT	; PRINT CHAR
	DBNZ	PRFN1	; COUNT DOWN
	RET

;
; SAVE RETURN ADDRESS
;
RETSAVE:
	POP	DE	; GET RETURN ADDRESS
	POP	HL	; GET RETURN ADDRESS TO ZCPR3
	LD	(Z3RET),HL	; SAVE IT
	PUSH	HL	; PUT RETURN ADDRESS TO ZCPR3 BACK
	PUSH	DE	; PUT RETURN ADDRESS BACK
	RET

;
; EXIT TO ZCPR3
;
EXIT:
Z3RET	EQU	$+1	; POINTER TO IN-THE-CODE MODIFICATION
	LD	HL,0	; RETURN ADDRESS
	JP	(HL)		; GOTO ZCPR3

;
; TEST WHEEL BYTE FOR APPROVAL
;   IF WHEEL BYTE IS 0 (OFF), ABORT WITH A MESSAGE (FLUSH RET ADR AND EXIT)
;
	IF	WHEEL	;IF ANY WHEEL OPTION IS RUNNING
WHLTST:
	LD	A,(Z3WHL)	;GET WHEEL BYTE
	OR	A	;ZERO?
	RET	NZ
	POP	AF	;CLEAR STACK
	CALL	PRINT
	DB	' No Whee','l'+80H
	RET
	ENDIF		;WHEEL

;
; PRINT A DASH
;
	IF	LTON OR PEEKON
DASH:
	CALL	PRINT
	DB	' -',' '+80H
	RET
;
	ENDIF		;LTON OR PEEKON
;
; PRINT ADDRESS MESSAGE
;   PRINT ADDRESS IN DE
;
	IF	PEEKON OR POKEON
ADRAT:
	CALL	PRINT
	DB	' at',' '+80H
	LD	A,D	;PRINT HIGH
	CALL	PAHC
	LD	A,E	;PRINT LOW
	JP	PAHC
;
; EXTRACT HEXADECIMAL NUMBER FROM LINE PTED TO BY HL
;   RETURN WITH VALUE IN DE AND HL PTING TO OFFENDING CHAR
;
HEXNUM:
	LD	DE,0		;DE=ACCUMULATED VALUE
	LD	B,5		;B=CHAR COUNT
HNUM1:
	LD	A,(HL)		;GET CHAR
	CP	' '+1		;DONE?
	RET	C			;RETURN IF SPACE OR LESS
	INC	HL		;PT TO NEXT
	SUB	'0'		;CONVERT TO BINARY
	BRC	NUMERR		;RETURN AND DONE IF ERROR
	CP	10		;0-9?
	BRC	HNUM2
	SUB	7		;A-F?
	CP	10H		;ERROR?
	BRNC	NUMERR
HNUM2:
	LD	C,A		;DIGIT IN C
	LD	A,D		;GET ACCUMULATED VALUE
	RLCA			;EXCHANGE NYBBLES
	RLCA
	RLCA
	RLCA
	AND	0F0H		;MASK OUT LOW NYBBLE
	LD	D,A
	LD	A,E		;SWITCH LOW-ORDER NYBBLES
	RLCA
	RLCA
	RLCA
	RLCA
	LD	E,A		;HIGH NYBBLE OF E=NEW HIGH OF E,
				;  LOW NYBBLE OF E=NEW LOW OF D
	AND	0FH		;GET NEW LOW OF D
	OR	D		;MASK IN HIGH OF D
	LD	D,A		;NEW HIGH BYTE IN D
	LD	A,E
	AND	0F0H		;MASK OUT LOW OF E
	OR	C		;MASK IN NEW LOW
	LD	E,A		;NEW LOW BYTE IN E
	DBNZ	HNUM1		;COUNT DOWN
	RET
;
; NUMBER ERROR
;
NUMERR:
	CALL	PRINT
	DB	' Num','?'+80H
	JP	EXIT
;
; SKIP TO NEXT NON-BLANK
;
SKSP:
	LD	A,(HL)	;GET CHAR
	INC	HL	;PT TO NEXT
	CP	' '	;SKIP SPACES
	BRZ	SKSP
	DEC	HL	;PT TO GOOD CHAR
	OR	A	;SET EOL FLAG
	RET
;
	ENDIF		;PEEKON OR POKEON
;
; Test File in FCB for unambiguity and existence, ask user to delete if so
;   Return with Z flag set if R/O or no permission to delete
;
	IF	RENON OR CPON
EXTEST:
	CALL	AMBCHK		;AMBIGUOUS FILE NAMES NOT ALLOWED
	CALL	SEARF		;LOOK FOR SPECIFIED FILE
	BRZ	EXOK		;OK IF NOT FOUND
	CALL	GETSBIT		;POSITION INTO DIR
	INC	DE		;PT TO FILE NAME
	EX	DE,HL			;HL PTS TO FILE NAME
	PUSH	HL		;SAVE PTR TO FILE NAME
	CALL	PRFN		;PRINT FILE NAME
	POP	HL
	CALL	ROTEST		;CHECK FOR R/O
	BRNZ	EXER
	CALL	ERAQ		;ERASE?
	BRNZ	EXER		;RESTART AS ERROR IF NO
	LD	DE,FCB1		;PT TO FCB1
	LD	C,19		;DELETE FILE
	CALL	BDOS
EXOK:
	XOR	A
	DEC	A		;NZ = OK
	RET
EXER:
	XOR	A		;ERROR FLAG - FILE IS R/O OR NO PERMISSION
	RET

;
; CHECK FOR AMBIGUOUS FILE NAME IN FCB1
;   RETURN Z IF SO
;
AMBCHK:
	LD	HL,FCB1+1	;PT TO FCB
;
; CHECK FOR AMBIGUOUS FILE NAME PTED TO BY HL
;
AMBCHK1:
	PUSH	HL
	LD	B,11		;11 BYTES
AMB1:
	LD	A,(HL)		;GET CHAR
	AND	7FH		;MASK
	CP	'?'
	BRZ	AMB2
	INC	HL		;PT TO NEXT
	DBNZ	AMB1
	DEC	B		;SET NZ FLAG
	POP	DE
	RET
AMB2:
	POP	HL		;PT TO FILE NAME
	CALL	PRFN
	CALL	PRINT
	DB	' is AF','N'+80H
	JP	EXIT
;
	ENDIF		;RENON OR CPON
;
;  CHECK USER TO SEE IF HE APPROVES ERASE OF FILE
;	RETURN WITH Z IF YES
;
	IF	RENON OR CPON OR ERAON OR PROTON
ERAQ:
	CALL	PRINT
	DB	' - Eras','e'+80H
ERAQ1:
	CALL	PRINT
	DB	' (Y/N)?',' '+80H
	CALL	CONIN		;GET RESPONSE
	CP	'Y'		;KEY ON YES
	RET
;
	ENDIF		;RENON OR CPON OR ERAON OR PROTON
;
; TEST FILE PTED TO BY HL FOR R/O
;	NZ IF R/O
;
	IF	RENON OR ERAON OR CPON
ROTEST:
	PUSH	HL	;ADVANCE TO R/O BYTE
	LD	BC,8	;PT TO 9TH BYTE
	ADD	HL,BC
	LD	A,(HL)	;GET IT
	AND	80H	;MASK BIT
	PUSH	AF
	LD	HL,ROMSG
	CALL	NZ,PRINT1	;PRINT IF NZ
	POP	AF	;GET FLAG
	POP	HL	;GET PTR
	RET
ROMSG:
	DB	' is R/','O'+80H
;
	ENDIF		;RENON OR ERAON OR CPON
;
; INIT FCB1, RETURN WITH DE PTING TO FCB1
;
	IF	ERAON OR LTON OR CPON
INITFCB1:
	LD	HL,FCB1		;PT TO FCB
INITFCB2:
	PUSH	HL		;SAVE PTR
	LD	BC,12		;PT TO FIRST BYTE
	ADD	HL,BC
	LD	B,24		;ZERO 24 BYTES
	XOR	A		;ZERO FILL
	CALL	FILLP		;FILL MEMORY
	POP	DE		;PT TO FCB
	RET
;
	ENDIF		;ERAON OR LTON OR CPON
;
; BUFFERS
;
NXTFILE:
	DS	2	;PTR TO NEXT FILE IN LIST

;
; SIZE ERROR TEST
;
	IF	[$ GT [RCP + RCPS*128 - 1]]
SIZERR	EQU	NOVALUE	;RCP IS TOO LARGE FOR BUFFER
	ENDIF

;
; END OF SYS.RCP
;

	END