RomWBW/Source/Images/d_bp/u15/SYSRCP.ASM

*  SYSTEM SEGMENT:  SYS.RCP
*  SYSTEM:  ARIES-1
*  CUSTOMIZED BY:  RICHARD CONN

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

*
*	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

;
CTRLC	EQU	'C'-'@'
TAB	EQU	09H
LF	EQU	0AH
FF	EQU	0CH
CR	EQU	0DH
CTRLX	EQU	'X'-'@'
;
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	32		;USE 4K FOR BUFFERING OF COPY
;
$-MACRO 		;FIRST TURN OFF THE EXPANSIONS
;
; MACROS TO PROVIDE Z80 EXTENSIONS
;   MACROS INCLUDE:
;
;	JR	- JUMP RELATIVE
;	JRC	- JUMP RELATIVE IF CARRY
;	JRNC	- JUMP RELATIVE IF NO CARRY
;	JRZ	- JUMP RELATIVE IF ZERO
;	JRNZ	- JUMP RELATIVE IF NO ZERO
;	DJNZ	- 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,?DD	;Displacement Range Error on Jump Relative
	ELSE
	DB	?DD
	ENDIF		;;RANGE ERROR
	ENDM
;
;
; Z80 MACRO EXTENSIONS
;
JR	MACRO	?N	;;JUMP RELATIVE
	IF	I8080	;;8080/8085
	JMP	?N
	ELSE		;;Z80
	DB	18H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
JRC	MACRO	?N	;;JUMP RELATIVE ON CARRY
	IF	I8080	;;8080/8085
	JC	?N
	ELSE		;;Z80
	DB	38H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
JRNC	MACRO	?N	;;JUMP RELATIVE ON NO CARRY
	IF	I8080	;;8080/8085
	JNC	?N
	ELSE		;;Z80
	DB	30H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
JRZ	MACRO	?N	;;JUMP RELATIVE ON ZERO
	IF	I8080	;;8080/8085
	JZ	?N
	ELSE		;;Z80
	DB	28H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
JRNZ	MACRO	?N	;;JUMP RELATIVE ON NO ZERO
	IF	I8080	;;8080/8085
	JNZ	?N
	ELSE		;;Z80
	DB	20H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
DJNZ	MACRO	?N	;;DECREMENT B AND JUMP RELATIVE ON NO ZERO
	IF	I8080	;;8080/8085
	DCR	B
	JNZ	?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	4		; NUMBER OF CHARS IN COMMAND NAME
	db	cnsize	; size of text entries
ctab:
	db	'H   '	; Help for RCP
	dw	clist
ctab1:
;
	IF	CPON
	db	'CP  '	; Copy
	dw	copy
	ENDIF		;CPON
;
	IF	DIRON
	db	'DIR '	; Directory
	dw	dir
	ENDIF		;DIRON
;
	IF	ECHOON
	db	'ECHO'	; Echo
	dw	echo
	ENDIF
;
	IF	ERAON
	db	'ERA '	; Erase
	dw	era
	ENDIF		;ERAON
;
	IF	LTON AND LISTON
	db	'LIST'	; List
	dw	list
	ENDIF		;LTON AND LISTON
;
	IF	NOTEON
	db	'NOTE'	; Note-Comment-NOP Command
	dw	note
	ENDIF
;
	IF	PEEKON
	db	'P   '	; Peek into Memory
	dw	peek
	ENDIF		;PEEKON
;
	IF	POKEON
	db	'POKE'	; Poke Values into Memory
	dw	poke
	ENDIF		;POKEON
;
	IF	PROTON
	db	'PROT'	; Protection Codes
	dw	att
	ENDIF		;PROTON
;
	IF	REGON
	db	'REG '	; Register Command
	dw	regcmd
	ENDIF		;RSETON
;
	IF	RENON
	db	'REN '	; Rename
	dw	ren
	ENDIF		;RENON
;
	IF	LTON
	db	'TYPE'	; Type
	dw	type
	ENDIF		;LTON
;
	IF	WHLON
	db	'WHL '	; Wheel
	dw	whl
	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:
	lxi	h,rcp$name	; print RCP Name
	call	print1
	lxi	h,ctab1		; print table entries
	mvi	c,1		; set count for new line
clist1:
	mov	a,m		; done?
	ora	a
	rz
	dcr	c		; count down
	jrnz	clist1a
	call	crlf		; new line
	mvi	c,4		; set count
clist1a:
	lxi	d,entryname	; copy command name into message buffer
	mvi	b,cnsize	; number of chars
clist2:
	mov	a,m		; copy
	stax	d
	inx	h		; pt to next
	inx	d
	dcr	b
	jnz	clist2
	inx	h		; skip to next entry
	inx	h
	push	h		; save ptr
	lxi	h,entrymsg	; print message
	call	print1
	pop	h		; get ptr
	jmp	clist1
*
*  Console Output Routine
*
conout:
	push	h		; save regs
	push	d
	push	b
	push	psw
	ani	7fh		; mask MSB
	mov	e,a		; char in E
	mvi	c,2		; output
	call	bdos
	pop	psw		; get regs
	pop	b
	pop	d
	pop	h
;
;  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:
	xthl			; get address
	call	print1
	xthl			; put address
	ret
*
*  Print String (terminated in 0 or MSB Set) pted to by HL
*
print1:
	mov	a,m		; done?
	inx	h		; pt to next
	ora	a		; 0 terminator
	rz
	call	conout		; print char
	rm			; MSB terminator
	jmp	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 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
	LXI	H,FCB1+1 	;MAKE FCB WILD (ALL '?') IF NO FILENAME.TYP
	MOV	A,M		;GET FIRST CHAR OF FILENAME.TYP
	CPI	' '		;IF <SP>, ALL WILD
	CZ	FILLQ
	LDA	FCB2+1		;GET FIRST CHAR OF 2ND FILE NAME
	MVI	B,80H		;PREPARE FOR DIR-ONLY SELECTION
	CPI	' '		;ANY FLAG?
	JRZ	DIRPR		;THERE IS NO FLAG, SO DIR ONLY
	MVI	B,1		;SET FOR BOTH DIR AND SYS FILES
	CPI	SYSFLG		;SYSTEM AND DIR FLAG SPECIFIER?
	JRZ	DIRPR		;GOT SYSTEM SPECIFIER
	CPI	SOFLG		;SYS ONLY?
	JRNZ	DIRPR
	DCR	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:
	MOV	A,B		;GET SYSTST FLAG
	CALL	GETDIR		;LOAD AND SORT DIRECTORY
	JZ	PRFNF		;PRINT NO FILE MESSAGE
	MVI	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:
	MOV	A,M		;CHECK FOR DONE
	ORA	A
	JZ	EXIT		;EXIT IF DONE
	MOV	A,E		;GET ENTRY COUNTER
	ORA	A		;OUTPUT <CRLF> IF 4 ENTRIES PRINTED IN LINE
	CZ	DIRCRLF		;NEW LINE
	MOV	A,E		;GET ENTRY COUNT
	CPI	4		;FIRST ENTRY?
	JRZ	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
	DCR	E		;DECREMENT ENTRY COUNTER
	JR	DIR3
;
; CRLF FOR DIR ROUTINE
;
DIRCRLF:
	PUSH	PSW		;DON'T AFFECT PSW
	CALL	CRLF		;NEW LINE
	POP	PSW
	MVI	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:
	DCR	A		;ADJUST TO RETURNED VALUE
	RRC			;CONVERT NUMBER TO OFFSET INTO TBUFF
	RRC
	RRC
	ANI	60H
	MOV	C,A		;OFFSET INTO TBUFF IN C (C=OFFSET TO ENTRY)
	LXI	D,TBUFF		;PT TO BUFFER
	MOV	A,E		;BASE ADDRESS IN A
	ADD	C		;ADD IN ENTRY OFFSET
	MOV	E,A		;RESULT IN E
	PUSH	D		;SAVE PTR IN DE
	ADI	10		;ADD OFFSET OF 10 TO PT TO SYSTEM BYTE
	MOV	E,A		;SET ADDRESS
	LDAX	D		;GET BYTE
	POP	D		;GET PTR IN DE
	ANI	80H		;LOOK AT ONLY SYSTEM BIT
SYSTST	EQU	$+1		;IN-THE-CODE VARIABLE
	XRI	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:
	MVI	B,11		;NUMBER OF CHARS IN FN & FT
	MVI	A,'?'		;STORE '?'
FILLP:
	MOV	M,A		;STORE BYTE
	INX	H		;PT TO NEXT
	DJNZ	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:
	STA	SYSTST	; SET SYSTEM TEST FLAG
	CALL	LOGUSR	; LOG INTO USER AREA OF FCB1
	LXI	H,DIRBUF	; PT TO DIR BUFFER
	MVI	M,0	; SET EMPTY
	LXI	B,0	; SET COUNTER
	CALL	SEARF	; LOOK FOR MATCH
	RZ		; RETURN IF NOT FOUND
;
;  STEP 1:  LOAD DIRECTORY
;
GD1:
	PUSH	B	; SAVE COUNTER
	CALL	GETSBIT	; CHECK FOR SYSTEM OK
	POP	B
	JRZ	GD2	; NOT OK, SO SKIP
	PUSH	B	; SAVE COUNTER
	INX	D	; PT TO FILE NAME
	XCHG		; HL PTS TO FILE NAME, DE PTS TO BUFFER
	MVI	B,11	; COPY 11 BYTES
	CALL	LDIR	; DO COPY
	XCHG		; HL PTS TO NEXT BUFFER LOCATION
	POP	B	; GET COUNTER
	INX	B	; INCREMENT COUNTER
GD2:
	CALL	SEARN	; LOOK FOR NEXT
	JRNZ	GD1
	MVI	M,0	; STORE ENDING 0
	LXI	H,DIRBUF	; PT TO DIR BUFFER
	MOV	A,M	; CHECK FOR EMPTY
	ORA	A
	RZ
;
;  STEP 2:  SORT DIRECTORY
;
	PUSH	H	; SAVE PTR TO DIRBUF FOR RETURN
	CALL	DIRALPHA	; SORT
	POP	H
	XRA	A	; SET NZ FLAG FOR OK
	DCR	A
	RET

;*
;*  DIRALPHA -- ALPHABETIZES DIRECTORY IN DIRBUF; BC CONTAINS
;*	THE NUMBER OF FILES IN THE DIRECTORY
;*
DIRALPHA:
	MOV	A,B	; ANY FILES?
	ORA	C
	RZ
	MOV	H,B	; HL=BC=FILE COUNT
	MOV	L,C
	SHLD	N	; 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
	LXI	H,0	; NUMBER OF ITEMS TO SORT
	SHLD	GAP	; SET INITIAL GAP TO N FOR FIRST DIVISION BY 2

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

;*  TEST FOR ZERO
	ORA	H
	RZ		; DONE WITH SORT IF GAP = 0

	SHLD	GAP	; SET VALUE OF GAP
	SHLD	I	; SET I=GAP FOR FOLLOWING LOOP

;*  FOR (I = GAP + 1; I <= N; I = I + 1)
SRTL1:
I	EQU	$+1	; POINTER FOR IN-THE-CODE MODIFICATION
	LXI	H,0	; ADD 1 TO I
	INX	H
	SHLD	I

;*  TEST FOR I <= N
	XCHG		; I IS IN DE
	LHLD	N	; GET N
	MOV	A,L	; COMPARE BY SUBTRACTION
	SUB	E
	MOV	A,H
	SBB	D	; CARRY SET MEANS I > N
	JRC	SRTL0	; DON'T DO FOR LOOP IF I > N

	LHLD	I	; SET J = I INITIALLY FOR FIRST SUBTRACTION OF GAP
	SHLD	J

;*  FOR (J = I - GAP; J > 0; J = J - GAP)
SRTL2:
	LHLD	GAP	; GET GAP
	XCHG		; ... IN DE
J	EQU	$+1	; POINTER FOR IN-THE-CODE MODIFICATION
	LXI	H,0	; GET J
	MOV	A,L	; COMPUTE J - GAP
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	SHLD	J	; J = J - GAP
	JRC	SRTL1	; IF CARRY FROM SUBTRACTIONS, J < 0 AND ABORT
	MOV	A,H	; J=0?
	ORA	L
	JRZ	SRTL1	; IF ZERO, J=0 AND ABORT

;*  SET JG = J + GAP
	XCHG		; J IN DE
	LHLD	GAP	; GET GAP
	DAD	D	; J + GAP
	SHLD	JG	; JG = J + GAP

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

;*  ... THEN BREAK
	JRC	SRTL1

;*  ... ELSE EXCHANGE
	LHLD	J	; SWAP J, JG
	XCHG
JG	EQU	$+1	; POINTER FOR IN-THE-CODE MODIFICATION
	LXI	H,0
	CALL	ISWAP	; J IN DE, JG IN HL

;*  END OF INNER-MOST FOR LOOP
	JR	SRTL2

;*
;*  SWAP (Exchange) the elements whose indexes are in HL and DE
;*
ISWAP:
	CALL	IPOS		; COMPUTE POSITION FROM INDEX
	XCHG
	CALL	IPOS		; COMPUTE 2ND ELEMENT POSITION FROM INDEX
	MVI	B,11		; 11 BYTES TO FLIP
ISWAP1:
	LDAX	D		; GET BYTES
	MOV	C,M
	MOV	M,A		; PUT BYTES
	MOV	A,C
	STAX	D
	INX	H		; PT TO NEXT
	INX	D
	DJNZ	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
	XCHG
	CALL	IPOS		; GET POSITION OF 2ND ELEMENT
	XCHG
;*
;*  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	H
	PUSH	D
	LXI	B,8	; PT TO FT (8 BYTES)
	DAD	B
	XCHG
	DAD	B
	XCHG		; DE, HL NOW PT TO THEIR FT'S
	MVI	B,3	; 3 BYTES
	CALL	COMP	; COMPARE FT'S
	POP	D
	POP	H
	RNZ		; CONTINUE IF COMPLETE MATCH
	MVI	B,8	; 8 BYTES
	JR	COMP	; COMPARE FN'S
;
	ELSE		; NAME AND TYPE
;*
;*  COMPARE BY FILE NAME AND FILE TYPE
;*
	MVI	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:
	MOV	A,M	; GET (HL)
	ANI	7FH	; MASK MSB
	MOV	C,A	; ... IN C
	LDAX	D	; COMPARE
	ANI	7FH	; MASK MSB
	CMP	C
	RNZ
	INX	H	; PT TO NEXT
	INX	D
	DJNZ	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:
	DCX	H		; HL=(HL-1)*11+DIRBUF
	MOV	B,H		; BC=HL
	MOV	C,L
	DAD	H		; HL=HL*2
	DAD	H		; HL=HL*4
	DAD	B		; HL=HL*5
	DAD	H		; HL=HL*10
	DAD	B		; HL=HL*11
	LXI	B,DIRBUF	; ADD IN DIRBUF
	DAD	B
	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
	LDA	FCB2+1		;GET ERAFLG IF IT'S THERE
	STA	ERAFLG		;SAVE IT AS A FLAG
	MVI	A,1		;DIR FILES ONLY
	CALL	GETDIR		;LOAD DIRECTORY OF FILES
	JZ	PRFNF		;ABORT IF NO FILES
;
; MAIN ERASE LOOP
;
ERA1:
	PUSH	H		;SAVE PTR TO FILE
	CALL	PRFN		;PRINT ITS NAME
	SHLD	NXTFILE		;SAVE PTR TO NEXT FILE
	POP	H		;GET PTR TO THIS FILE
	CALL	ROTEST		;TEST FILE PTED TO BY HL FOR R/O
	JRNZ	ERA3
ERAFLG	EQU	$+1		;ADDRESS OF FLAG
	MVI	A,0		;2ND BYTE IS FLAG
	CPI	'I'		;IS IT AN INSPECT OPTION?
	JRNZ	ERA2		;SKIP PROMPT IF IT IS NOT
	CALL	ERAQ		;ERASE?
	JRNZ	ERA3		;SKIP IF NOT
ERA2:
	LXI	D,FCB1+1	;COPY INTO FCB1
	MVI	B,11		;11 BYTES
	CALL	LDIR
	CALL	INITFCB1	;INIT FCB
	MVI	C,19		;DELETE FILE
	CALL	BDOS
ERA3:
	LHLD	NXTFILE		;HL PTS TO NEXT FILE
	MOV	A,M		;GET CHAR
	ORA	A		;DONE?
	JZ	EXIT
	CALL	CRLF		;NEW LINE
	JR	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
	MVI	A,0FFH		;TURN ON PRINTER FLAG
	JR	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
	XRA	A		;TURN OFF PRINTER FLAG
;
; ENTRY POINT FOR CPR LIST FUNCTION (LIST)
;
TYPE0:
	STA	PRFLG		;SET FLAG
	LDA	FCB2+1		;GET PAGE FLAG
	STA	PGFLG		;SAVE IT AS A FLAG
	MVI	A,1		;SELECT DIR FILES
	CALL	GETDIR		;ALLOW AMBIGUOUS FILES
	JZ	PRFNF		;NO FILES
	SHLD	NXTFILE		;SET PTR TO NEXT FILE
	JR	TYPEX2
TYPEX:
	LHLD	NXTFILE		;GET PTR TO NEXT FILE
	MOV	A,M		;ANY FILES?
	ORA	A
	JZ	EXIT
	LDA	PRFLG		;CHECK FOR LIST OUTPUT
	ORA	A		;0=TYPE
	JRZ	TYPEX1
	MVI	A,CR		;BOL ON PRINTER
	CALL	LCOUT
	MVI	A,FF		;FORM FEED THE PRINTER
	CALL	LCOUT
	JR	TYPEX2
TYPEX1:
	CALL	PAGEBREAK	;PAGE BREAK MESSAGE
TYPEX2:
	LXI	D,FCB1+1	;COPY INTO FCB1
	MVI	B,11		;11 BYTES
	CALL	LDIR
	SHLD	NXTFILE		;SET PTR TO NEXT FILE
	CALL	INITFCB1	;INIT FCB1
	MVI	C,15		;OPEN FILE
	CALL	BDOS
	INR	A		;SET ERROR FLAG
	JZ	PRFNF		;ABORT IF ERROR
	MVI	A,NLINES-2	;SET LINE COUNT
	STA	PAGCNT
	MVI	A,CR		;NEW LINE
	CALL	LCOUT
	MVI	A,LF
	CALL	LCOUT
	LXI	B,080H		;SET CHAR POSITION AND TAB COUNT
				;  (B=0=TAB, C=080H=CHAR POSITION)
;
;  MAIN LOOP FOR LOADING NEXT BLOCK
;
TYPE2:
	MOV	A,C		;GET CHAR COUNT
	CPI	80H
	JRC	TYPE3
	PUSH	H		;READ NEXT BLOCK
	PUSH	B
	LXI	D,FCB1		;PT TO FCB
	MVI	C,20		;READ RECORD
	CALL	BDOS
	ORA	A		;SET FLAGS
	POP	B
	POP	H
	JRNZ	TYPE7		;END OF FILE?
	MVI	C,0		;SET CHAR COUNT
	LXI	H,TBUFF		;PT TO FIRST CHAR
;
;  MAIN LOOP FOR PRINTING CHARS IN TBUFF
;
TYPE3:
	MOV	A,M		;GET NEXT CHAR
	ANI	7FH		;MASK OUT MSB
	CPI	1AH		;END OF FILE (^Z)?
	JRZ	TYPE7		;NEXT FILE IF SO
;
; OUTPUT CHAR TO CON: OR LST: DEVICE WITH TABULATION
;
	CPI	CR		;RESET TAB COUNT?
	JRZ	TYPE4
	CPI	LF		;RESET TAB COUNT?
	JRZ	TYPE4
	CPI	TAB		;TAB?
	JRZ	TYPE5
;
;  OUTPUT CHAR AND INCREMENT CHAR COUNT
;
	CALL	LCOUT		;OUTPUT CHAR
	JZ	TYPEX		;SKIP
	INR	B		;INCREMENT TAB COUNT
	JR	TYPE6
;
;  OUTPUT <CR> OR <LF> AND RESET TAB COUNT
;
TYPE4:
	CALL	LCOUT		;OUTPUT <CR> OR <LF>
	JZ	TYPEX		;SKIP
	MVI	B,0		;RESET TAB COUNTER
	JR	TYPE6
;
;  TABULATE
;
TYPE5:
	MVI	A,' '		;<SP>
	CALL	LCOUT
	JZ	TYPEX		;SKIP
	INR	B		;INCR POS COUNT
	MOV	A,B
	ANI	7
	JRNZ	TYPE5
;
; CONTINUE PROCESSING
;
TYPE6:
	INR	C		;INCREMENT CHAR COUNT
	INX	H		;PT TO NEXT CHAR
	CALL	BREAK		;CHECK FOR ABORT
	JZ	TYPEX		;SKIP
	JR	TYPE2
TYPE7:
	LXI	D,FCB1		;CLOSE FILE
	MVI	C,16		;BDOS FUNCTION
	CALL	BDOS
	JMP	TYPEX
;
; SEND OUTPUT TO LST: OR CON:, AS PER THE FLAG
;   RETURN WITH Z IF ABORT
;
LCOUT:
	PUSH	H		;SAVE REGS
	PUSH	D
	PUSH	B
	MOV	E,A		;CHAR IN E
	MVI	C,2		;OUTPUT TO CON:
PRFLG	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;2ND BYTE IS THE PRINT FLAG
	ORA	A		;0=TYPE
	JRZ	LC1
	MVI	C,5		;OUTPUT TO LST:
LC1:
	PUSH	D		;SAVE CHAR
	CALL	BDOS		;OUTPUT CHAR IN E
	POP	D		;GET CHAR
	MOV	A,E
	CPI	LF
	JRNZ	LC2
	LDA	PRFLG		;OUTPUT TO LST:?
	ORA	A		;NZ = YES
	JRNZ	LC2
;
; CHECK FOR PAGING
;
	LXI	H,PAGCNT	;COUNT DOWN
	DCR	M
	JRNZ	LC2		;JUMP IF NOT END OF PAUSE
	MVI	M,NLINES-2	;REFILL COUNTER
PGFLG	EQU	$+1		;POINTER TO IN-THE-CODE BUFFER
	MVI	A,0		;2ND BYTE IS THE PAGING FLAG
	CPI	PGDFLG		;PAGE DEFAULT OVERRIDE OPTION WANTED?
;
	IF	PGDFLT		;IF PAGING IS DEFAULT
;
	JRZ	LC2		;PGDFLG MEANS NO PAGING
;
	ELSE
;
	JRNZ	LC2		;PGDFLG MEANS PAGE
;
	ENDIF		;PGDFLT
;
	CALL	PAGEBREAK	;PRINT PAGE BREAK MESSAGE
	JR	LC3		;Z TO SKIP
LC2:
	XRA	A		;SET OK
	DCR	A		;NZ=OK
LC3:
	POP	B		;RESTORE REGS
	POP	D
	POP	H
	RET
;
; PRINT PAGE BREAK MESSAGE AND GET USER INPUT
;   ABORT IF ^C, RZ IF ^X
;
PAGEBREAK:
	PUSH	H		;SAVE HL
	CALL	PRINT
	DB	cr,lf,' Typing',' '+80H
	LXI	H,FCB1+1	;PRINT FILE NAME
	CALL	PRFN
	CALL	DASH		;PRINT DASH
	CALL	CONIN		;GET INPUT
	POP	H		;RESTORE HL
	PUSH	PSW
	CALL	CRLF		;NEW LINE
	POP	PSW
	CPI	CTRLC		;^C
	JZ	EXIT
	CPI	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
;
	LXI	H,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
	JZ	EXIT		;R/O OR NO PERMISSION
;
; STEP 4:  EXCHANGE FILE NAME FIELDS FOR RENAME
;
	LXI	H,FCB1		;EXCHANGE NAMES ONLY
	PUSH	H		;SAVE PTR
	INX	H
	LXI	D,FCB2+1
	MVI	B,11		;11 BYTES
REN1:
	LDAX	D		;GET OLD
	MOV	C,A
	MOV	A,M
	STAX	D		;PUT NEW
	MOV	M,C
	INX	H		;PT TO NEXT
	INX	D
	DJNZ	REN1
;
; STEP 5:  SEE IF OLD FILE IS R/O
;
	CALL	SEARF		;LOOK FOR FILE
	JZ	PRFNF
	CALL	GETSBIT		;GET PTR TO ENTRY IN TBUFF
	XCHG			;HL PTS TO ENTRY
	INX	H		;PT TO FN
	CALL	ROTEST		;SEE IF FILE IS R/O
	JNZ	EXIT
;
; STEP 6:  RENAME THE FILE
;
	POP	D		;GET PTR TO FCB
	MVI	C,23		;RENAME
	CALL	BDOS
	INR	A		;SET ZERO FLAG IF ERROR
	JZ	PRFNF		;PRINT NO SOURCE FILE MESSAGE
	JMP	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
	XRA	A		;SET NO INSPECT
	STA	INSPECT
	LXI	H,0		;SET R/O AND SYS ATTRIBUTES OFF
	LXI	D,FCB2+1	;PT TO ATTRIBUTES
	MVI	B,3		;3 CHARS MAX
ATT1:
	LDAX	D		;GET CHAR
	INX	D		;PT TO NEXT
	CPI	'I'		;INSPECT?
	JRZ	ATTI
	CPI	'R'		;SET R/O?
	JRZ	ATTR
	CPI	'S'		;SET SYS?
	JRZ	ATTS
ATT2:
	DJNZ	ATT1
	JR	ATT3
ATTI:
	STA	INSPECT		;SET FLAG
	JR	ATT2
ATTR:
	MVI	H,80H		;SET R/O BIT
	JR	ATT2
ATTS:
	MVI	L,80H		;SET SYS BIT
	JR	ATT2
ATT3:
	SHLD	FATT		;SAVE FILE ATTRIBUTES
	MVI	A,1		;SELECT DIR AND SYS FILES
	CALL	GETDIR		;LOAD DIRECTORY
	JZ	PRFNF		;NO FILE ERROR
	SHLD	NXTFILE		;PT TO NEXT FILE
	JR	ATT5
ATT4:
	LHLD	NXTFILE		;PT TO NEXT FILE
	MOV	A,M		;END OF LIST?
	ORA	A
	JZ	EXIT
	CALL	CRLF		;NEW LINE
ATT5:
	PUSH	H		;SAVE PTR TO CURRENT FILE
	CALL	PRFN		;PRINT ITS NAME
	SHLD	NXTFILE		;SAVE PTR TO NEXT FILE
	CALL	PRINT
	DB	' Set to R','/'+80H
	LHLD	FATT		;GET ATTRIBUTES
	MVI	C,'W'		;ASSUME R/W
	MOV	A,H		;GET R/O BIT
	ORA	A
	JRZ	ATT6
	MVI	C,'O'		;SET R/O
ATT6:
	MOV	A,C		;GET CHAR
	CALL	CONOUT
	MOV	A,L		;GET SYS FLAG
	ORA	A		;SET FLAG
	JRZ	ATT7
	CALL	PRINT
	DB	' and SY','S'+80H
ATT7:
INSPECT	EQU	$+1		;PTR FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;GET INSPECT FLAG
	ORA	A		;Z=NO
	POP	H		;GET PTR TO CURRENT FILE
	JRZ	ATT8
	CALL	ERAQ1		;ASK FOR Y/N
	JRNZ	ATT4		;ADVANCE TO NEXT FILE IF NOT Y
ATT8:
	LXI	D,FCB1+1	;COPY INTO FCB1
	MVI	B,11		;11 BYTES
	CALL	LDIR
FATT	EQU	$+1		;PTR FOR IN-THE-CODE MODIFICATION
	LXI	H,0		;GET ATTRIBUTES
	DCX	D		;PT TO SYS BYTE
	DCX	D
	MOV	A,L		;GET SYS FLAG
	CALL	ATTSET		;SET ATTRIBUTE CORRECTLY
	DCX	D		;PT TO R/O BYTE
	MOV	A,H		;GET R/O FLAG
	CALL	ATTSET
	LXI	D,FCB1		;PT TO FCB
	MVI	C,30		;SET ATTRIBUTES
	CALL	BDOS
	JR	ATT4
ATTSET:
	ORA	A		;0=CLEAR ATTRIBUTE
	JRZ	ATTST1
	LDAX	D		;GET BYTE
	ORI	80H		;SET ATTRIBUTE
	STAX	D
	RET
ATTST1:
	LDAX	D		;GET BYTE
	ANI	7FH		;CLEAR ATTRIBUTE
	STAX	D
	RET
;
	ENDIF		;PROTON
;
;Section 5G
;Command: CP
;Function:  To copy a file from one place to another
;
;Form:
;	CP new=old
;
	IF	CPON
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
;
	LXI	D,FCB1+1	;PT TO NEW FILE NAME
	LDAX	D		;GET FIRST CHAR
	CPI	' '		;NO NAME?
	JRNZ	COPY0
	LXI	H,FCB2+1	;MAKE SAME AS OLD
	MVI	B,11		;11 BYTES
	CALL	LDIR
;
; STEP 1:  SEE IF NEW=OLD AND ABORT IF SO
;
COPY0:
	LXI	H,FCB1		;PT TO NEXT
	LXI	D,FCB2		;PT TO OLD
	PUSH	H		;SAVE PTRS
	PUSH	D
	INX	H		;PT TO FILE NAME
	INX	D
	MVI	B,13		;COMPARE 13 BYTES
COPY1:
	LDAX	D		;GET OLD
	CMP	M		;COMPARE TO NEW
	JRNZ	COPY2
	INX	H		;PT TO NEXT
	INX	D
	DJNZ	COPY1
	MVI	C,25		;GET CURRENT DISK
	CALL	BDOS
	INR	A		;MAKE 1..P
	MOV	B,A		;CURRENT DISK IN B
	POP	D		;GET PTR TO DN
	POP	H
	LDAX	D		;GET DISK
	MOV	C,A		;... IN C
	ORA	A		;CURRENT?
	JRNZ	COPY1A
	MOV	C,B		;MAKE C CURRENT
COPY1A:
	MOV	A,M		;GET DISK
	ORA	A		;CURRENT?
	JRNZ	COPY1B
	MOV	A,B		;MAKE A CURRENT
COPY1B:
	CMP	C		;SAME DISK ALSO?
	JRNZ	COPY3		;CONTINUE WITH OPERATION
	JR	CPERR
COPY2:
	POP	D		;GET PTRS
	POP	H
;
; STEP 2:  SET USER NUMBERS
;
COPY3:
	LDA	FCB1+13		;GET NEW USER
	STA	USRNEW
	LDA	FCB2+13		;GET OLD USER
	STA	USROLD
;
; STEP 3:  SEE IF OLD FILE EXISTS
;
	LXI	H,OLDFCB	;COPY OLD INTO 2ND FCB
	PUSH	H		;SAVE PTR TO 2ND FCB
	XCHG
	MVI	B,14		;14 BYTES
	CALL	LDIR
	CALL	LOGOLD		;LOG IN USER NUMBER OF OLD FCB
	POP	H		;GET PTR TO 2ND FCB
	CALL	INITFCB2	;INIT FCB
	MVI	C,17		;LOOK FOR FILE
	CALL	BDOS
	INR	A		;CHECK FOR ERROR
	JZ	PRFNF		;FILE NOT FOUND
;
; STEP 4:  SEE IF NEW EXISTS
;
	CALL	LOGNEW		;LOG INTO NEW'S USER AREA
	CALL	EXTEST		;TEST
	JZ	EXIT		;ERROR EXIT
;
; STEP 5:  CREATE NEW
;
	LXI	D,FCB1		;PT TO FCB
	MVI	C,22		;MAKE FILE
	CALL	BDOS
	INR	A		;ERROR?
	JRNZ	COPY4
;
; COPY ERROR
;
CPERR:
	CALL	PRINT
	DB	' Copy','?'+80H
	JMP	EXIT
;
; STEP 6:  OPEN OLD
;
COPY4:
	CALL	LOGOLD		;GET USER
	LXI	H,OLDFCB	;PT TO FCB
	CALL	INITFCB2	;INIT FCB
	MVI	C,15		;OPEN FILE
	CALL	BDOS
;
; STEP 7:  COPY OLD TO NEW WITH BUFFERING
;
COPY5:
	CALL	LOGOLD		;GET USER
	MVI	B,0		;SET COUNTER
	LXI	H,TPA		;SET NEXT ADDRESS TO COPY INTO
COPY5A:
	PUSH	H		;SAVE ADDRESS AND COUNTER
	PUSH	B
	LXI	D,OLDFCB	;READ BLOCK FROM FILE
	MVI	C,20
	CALL	BDOS
	POP	B		;GET COUNTER AND ADDRESS
	POP	D
	ORA	A		;OK?
	JRNZ	COPY5B
	PUSH	B		;SAVE COUNTER
	LXI	H,TBUFF		;COPY FROM BUFFER
	MVI	B,128		;128 BYTES
	CALL	LDIR
	XCHG			;HL PTS TO NEXT
	POP	B		;GET COUNTER
	INR	B		;INCREMENT IT
	MOV	A,B		;DONE?
	CPI	CPBLOCKS	;DONE IF CPBLOCKS LOADED
	JRNZ	COPY5A
COPY5B:
	MOV	A,B		;GET COUNT
	ORA	A
	JRZ	COPY6		;DONE IF NOTHING LOADED
	PUSH	B		;SAVE COUNT
	CALL	LOGNEW		;GET USER
	LXI	H,TPA		;PT TO TPA
COPY5C:
	LXI	D,TBUFF		;COPY INTO TBUFF
	MVI	B,128		;128 BYTES
	CALL	LDIR
	PUSH	H		;SAVE PTR TO NEXT
	LXI	D,FCB1		;PT TO FCB
	MVI	C,21		;WRITE BLOCK
	CALL	BDOS
	ORA	A
	JRNZ	CPERR		;COPY ERROR
	POP	H		;GET PTR TO NEXT BLOCK
	POP	B		;GET COUNT
	DCR	B		;COUNT DOWN
	JRZ	COPY5		;GET NEXT
	PUSH	B		;SAVE COUNT
	JR	COPY5C
;
; STEP 8:  CLOSE FILES
;
COPY6:
	CALL	LOGOLD		;GET USER
	LXI	D,OLDFCB	;PT TO FCB
	MVI	C,16		;CLOSE FILE
	CALL	BDOS
	CALL	LOGNEW		;GET USER
	LXI	D,FCB1		;PT TO FCB
	MVI	C,16		;CLOSE FILE
	CALL	BDOS
	CALL	PRINT
	DB	' Don','e'+80H
	JMP	EXIT
;
; LOG INTO USER NUMBER OF OLD FILE
;
LOGOLD:
USROLD	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;GET NUMBER
	JMP	SETUSR
;
; LOG INTO USER NUMBER OF NEW FILE
;
LOGNEW:
USRNEW	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;GET NUMBER
	JMP	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
	LXI	H,TBUFF+1	;FIND FIRST NUMBER
NXTPEEK	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	LXI	D,0		;DEFAULT PEEK ADDRESS IF NONE
	CALL	SKSP		;SKIP TO NON-BLANK
	CNZ	HEXNUM		;GET START ADDRESS IF ANY (ELSE DEFAULT)
	CALL	PRINT
	DB	' Pee','k'+80H
	CALL	ADRAT		;PRINT ADDRESS MESSAGE
	PUSH	D		;SAVE IT
	LXI	B,256		;COMPUTE END ADDRESS
	XCHG
	DAD	B
	XCHG			;END ADDRESS IN DE
	CALL	SKSP		;SKIP TO NON-BLANK
	JRZ	PEEK1		;PROCESS
	CALL	HEXNUM		;GET 2ND NUMBER IN DE
PEEK1:
	POP	H		;HL IS START ADDRESS, DE IS END ADDRESS
	CALL	PEEK2		;DO PEEK
	SHLD	NXTPEEK		;SET CONTINUED PEEK ADDRESS
	JMP	EXIT
;
; DISPLAY LOOP
;
PEEK2:
	MOV	A,D		;SEE IF DE<=HL
	CMP	H
	RC			;OUT OF BOUNDS
	JRNZ	PEEK2A		;HL > DE
	MOV	A,E
	CMP	L
	RZ
	RC
PEEK2A:
	CALL	CRLF		;NEW LINE
	MOV	A,H		;PRINT ADDRESS
	CALL	PASHC
	MOV	A,L
	CALL	PAHC
	CALL	DASH		;PRINT LEADER
	MVI	B,16		;16 BYTES TO DISPLAY
	PUSH	H		;SAVE START ADDRESS
PEEK3:
	MOV	A,M		;GET NEXT BYTE
	CALL	PASHC		;PRINT WITH LEADING SPACE
	INX	H		;PT TO NEXT
	DJNZ	PEEK3
	POP	H		;PT TO FIRST
	MVI	B,16		;16 BYTES
	MVI	A,' '		;SPACE AND FENCE
	CALL	CONOUT
	CALL	PRINT
	DB	FENCE+80H
PEEK4:
	MOV	A,M		;GET NEXT BYTE
	MVI	C,'.'		;ASSUME DOT
	ANI	7FH		;MASK IT
	CPI	' '		;DOT IF LESS THAN SPACE
	JRC	PEEK5
	CPI	7FH		;DON'T PRINT DEL
	JRZ	PEEK5
	MOV	C,A		;CHAR IN C
PEEK5:
	MOV	A,C		;GET CHAR
	CALL	CONOUT		;SEND IT
	INX	H		;PT TO NEXT
	DJNZ	PEEK4
	CALL	PRINT		;CLOSING FENCE
	DB	FENCE+80H
	CALL	BREAK		;ALLOW ABORT
	JR	PEEK2
;
	ENDIF		;PEEKON
;
; PRINT A AS 2 HEX CHARS
;   PASHC - LEADING SPACE
;
	IF	PEEKON OR POKEON
PASHC:
	PUSH	PSW		;SAVE A
	CALL	PRINT
	DB	' '+80H
	POP	PSW
PAHC:
	PUSH	B		;SAVE BC
	MOV	C,A		;BYTE IN C
	RRC			;EXCHANGE NYBBLES
	RRC
	RRC
	RRC
	CALL	PAH		;PRINT HEX CHAR
	MOV	A,C		;GET LOW
	POP	B		;RESTORE BC AND FALL THRU TO PAH
PAH:
	ANI	0FH		;MASK
	ADI	'0'		;CONVERT TO ASCII
	CPI	'9'+1		;LETTER?
	JRC	PAH1
	ADI	7		;ADJUST TO LETTER
PAH1:
	JMP	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
	LXI	H,TBUFF+1	;PT TO FIRST CHAR
	CALL	SKSP		;SKIP TO NON-BLANK
	JRZ	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	D		;SAVE ADDRESS
	CALL	SKSP		;SKIP TO NON-BLANK
	JZ	EXIT		;DONE
	CPI	'"'		;QUOTED TEXT?
	JRZ	POKE2
	CALL	HEXNUM		;GET NUMBER
	MOV	A,E		;GET LOW
	POP	D		;GET ADDRESS
	STAX	D		;STORE NUMBER
	INX	D		;PT TO NEXT
	JR	POKE1
;
; STORE ASCII CHARS
;
POKE2:
	POP	D		;GET NEXT ADDRESS
	INX	H		;PT TO NEXT CHAR
POKE3:
	MOV	A,M		;GET NEXT CHAR
	ORA	A		;DONE?
	JZ	EXIT
	STAX	D		;PUT CHAR
	INX	H		;PT TO NEXT
	INX	D
	JR	POKE3
;
; No Argument Error
;
NOARGS:
	CALL	PRINT
	DB	' Arg','?'+80H
	JMP	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
REGCMD:
	LXI	H,FCB1+1	;PT TO FIRST ARG
	MOV	A,M		;GET FIRST CHAR
	PUSH	PSW		;SAVE CHAR
	CPI	'A'		;ASSUME DIGIT IF LESS THAN 'A'
	JRC	REGC1
	INX	H		;PT TO DIGIT
REGC1:
	MOV	A,M		;GET DIGIT
	CALL	REGPTR		;PT TO REGISTER
	POP	PSW		;GET CHAR
	CPI	'S'		;SET?
	JRZ	RSET
	CPI	'P'		;PLUS?
	JRZ	RINC
	CPI	'M'		;MINUS?
	JRZ	RDEC
;
; SHOW REGISTER VALUES
;
RSHOW:
	XRA	A		;SELECT REGISTER 0
	MOV	B,A		;COUNTER SET TO 0 IN B
	CALL	REGP2		;HL PTS TO REGISTER 0
RSHOW1:
	MOV	A,B		;GET COUNTER VALUE
	CPI	10
	JZ	CRLF		;NEW LINE AND EXIT IF DONE
	CALL	PRINT
	DB	'  Reg',' '+80H
	MOV	A,B		;PRINT REGISTER NUMBER
	ADI	'0'
	CALL	CONOUT
	CALL	PRINT
	DB	' ','='+80H
	PUSH	B		;SAVE COUNTER
	CALL	REGOUT		;PRINT REGISTER VALUE
	POP	B		;GET COUNTER
	INR	B		;INCREMENT COUNTER
	MOV	A,B		;CHECK FOR NEW LINE
	ANI	3
	CZ	CRLF
	INX	H		;PT TO NEXT REGISTER
	JR	RSHOW1
;
; INCREMENT REGISTER VALUE
;	HL PTS TO MEMORY REGISTER ON INPUT
;
RINC:
	INR	M	;INCREMENT IT
	JR	REGOUT	;PRINT RESULT
;
; DECREMENT REGISTER VALUE
;	HL PTS TO MEMORY REGISTER ON INPUT
;
RDEC:
	DCR	M	;DECREMENT VALUE
	JR	REGOUT	;PRINT RESULT
;
; SET REGISTER VALUE
;	HL PTS TO REGISTER ON INPUT
;
RSET:
	LXI	D,FCB2+1	;PT TO VALUE
	MVI	B,0	;INIT VALUE TO ZERO
RSET1:
	LDAX	D	;GET NEXT DIGIT
	INX	D	;PT TO NEXT
	SUI	'0'	;CONVERT TO BINARY
	JRC	RSET2
	CPI	10	;RANGE?
	JRNC	RSET2
	MOV	C,A	;DIGIT IN C
	MOV	A,B	;MULTIPLY OLD BY 10
	ADD	A	;*2
	ADD	A	;*4
	ADD	B	;*5
	ADD	A	;*10
	ADD	C	;ADD IN NEW DIGIT
	MOV	B,A	;RESULT IN B
	JR	RSET1
RSET2:
	MOV	M,B	;SET VALUE
REGOUT:
	CALL	PRINT	;PRINT LEADING SPACE
	DB	' '+80H
	MOV	A,M	;GET REGISTER VALUE
	MVI	B,100	;PRINT 100'S
	MVI	C,0	;SET LEADING SPACE FLAG
	CALL	DECB	;PRINT 100'S
	MVI	B,10	;PRINT 10'S
	CALL	DECB	;PRINT 10'S
	ADI	'0'	;PRINT 1'S
	JMP	CONOUT
;
; SUBTRACT B FROM A UNTIL CARRY, THEN PRINT DIGIT COUNT
;
DECB:
	MVI	D,'0'	;SET DIGIT
DECB1:
	SUB	B	;SUBTRACT
	JRC	DECB2
	INR	D	;ADD 1 TO DIGIT CHAR
	JR	DECB1
DECB2:
	ADD	B	;ADD BACK IN
	MOV	E,A	;SAVE A IN E
	MOV	A,D	;GET DIGIT CHAR
	CPI	'0'	;LEADING ZERO CHECK
	JRNZ	DECB3
	MOV	A,C	;ANY LEADING DIGIT YET?
	ORA	A
	JRZ	DECB4
DECB3:
	MOV	A,D	;GET DIGIT CHAR
	CALL	CONOUT	;PRINT IT
	INR	C	;SET C<>0 FOR LEADING DIGIT CHECK
DECB4:
	MOV	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:
	MVI	B,0	;INIT TO ZERO
	SUI	'0'	;CONVERT
	JRC	REGP1
	CPI	10	;RANGE
	JRNC	REGP1
	MOV	B,A	;VALUE IN B
REGP1:
	MOV	A,B	;VALUE IN A
REGP2:
	LXI	H,Z3MSG+30H	;PT TO MEMORY REGISTERS
	ADD	L	;PT TO PROPER REGISTER
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A	;HL PTS TO REGISTER
	RET
;
	ENDIF		;REGON

;
;Section 5K
;Command: WHL/WHLQ
;Function:  Set the Wheel Byte on or off
;
;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:
	LXI	H,FCB1+1	;PT TO FIRST CHAR
	MOV	A,M	;GET IT
	CPI	' '	;TURN BYTE OFF IF NO PASSWORD
	JRZ	WHLOFF
	LXI	D,WHLPASS
	MVI	B,8	;CHECK 8 CHARS
WHL1:
	LDAX	D	;GET CHAR
	CMP	M	;COMPARE
	JRNZ	WHLMSG
	INX	H	;PT TO NEXT
	INX	D
	DJNZ	WHL1
;
; TURN ON WHEEL BYTE
;
	MVI	A,0FFH	;TURN ON WHEEL BYTE
	JR	WHLSET
;
; TURN OFF WHEEL BYTE
;
WHLOFF:
	XRA	A	;TURN OFF WHEEL BYTE
WHLSET:
	STA	Z3WHL	;SET WHEEL BYTE AND PRINT MESSAGE
;
; PRINT WHEEL BYTE MESSAGE
;
WHLMSG:
	CALL	PRINT
	DB	' Wheel Byte',' '+80H
	LDA	Z3WHL	;GET WHEEL BYTE
	ORA	A	;ZERO IS OFF
	JRZ	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:
	LXI	H,TBUFF+1	;PT TO FIRST CHAR
ECHO1:
	MOV	A,M		;SKIP LEADING SPACES
	INX	H		;PT TO NEXT
	CPI	' '
	JRZ	ECHO1
;
	IF	ECHOLST
	MOV	B,A		;CHAR IN B
	CPI	'$'		;PRINT FLAG?
	JRZ	ECHO2
	ENDIF		;ECHOLST
;
	DCX	H		;PT TO CHAR
;
; LOOP TO ECHO CHARS
;
ECHO2:
	MOV	A,M		;GET CHAR
	ORA	A		;EOL?
	JRZ	ECHO4
;
	IF	ECHOLST
	CPI	FF		;FORM FEED?
	JRZ	ECHO3
	ENDIF		;ECHOLST
;
ECHO2C:
	CALL	ECHOUT		;SEND CHAR
	INX	H		;PT TO NEXT
	JR	ECHO2
;
; FORM FEED - SEND NEW LINE FOLLOWED BY FORM FEED IF PRINTER OUTPUT
;
	IF	ECHOLST
ECHO3:
	MOV	A,B		;CHECK FOR PRINTER OUTPUT
	CPI	'$'
	JRNZ	ECHOFF		;SEND FORM FEED NORMALLY IF NOT PRINTER
	CALL	ECHONL		;SEND NEW LINE
	MVI	A,FF		;SEND FORM FEED
	JR	ECHOUT
;
; SEND FORM FEED CHAR TO CONSOLE
;
ECHOFF:
	MVI	A,FF		;GET CHAR
	JR	ECHO2C
	ENDIF		;ECHOLST
;
; END OF PRINT LOOP - CHECK FOR PRINTER TERMINATION
;
ECHO4:
	IF	NOT ECHOLST
;
	RET
;
	ELSE
;
	MOV	A,B		;CHECK FOR PRINTER OUTPUT
	CPI	'$'
	RNZ			;DONE IF NO PRINTER OUTPUT
;
; OUTPUT A NEW LINE
;
ECHONL:
	MVI	A,CR		;OUTPUT NEW LINE ON PRINTER
	CALL	ECHOUT
	MVI	A,LF		;FALL THRU TO ECHOUT
;
	ENDIF		;NOT ECHOLST
;
; OUTPUT CHAR TO PRINTER OR CONSOLE
;
ECHOUT:
	MOV	C,A		;CHAR IN C
	PUSH	H		;SAVE HL
	PUSH	B		;SAVE BC
	LXI	D,0CH-3		;OFFSET FOR CONSOLE OUTPUT
;
	IF	ECHOLST
	MOV	A,B		;CHECK FOR PRINTER
	CPI	'$'
	JRNZ	ECHOUT1
	INX	D		;ADD 3 FOR PRINTER OFFSET
	INX	D
	INX	D
;
	ENDIF		;ECHOLST
;
; OUTPUT CHAR IN C WITH BIOS OFFSET IN DE
;
ECHOUT1:
	CALL	BIOUT		;BIOS OUTPUT
	POP	B		;RESTORE BC,HL
	POP	H
	RET

;
; OUTPUT CHAR IN C TO BIOS WITH OFFSET IN DE
;
BIOUT:
	LHLD	WBOOT+1		;GET ADDRESS OF WARM BOOT
	DAD	D		;PT TO ROUTINE
	PCHL			;JUMP TO IT

;
;  ** SUPPORT UTILITIES **
;

;
;  CHECK FOR USER INPUT; IF ^C, RETURN WITH Z
;
BREAK:
	PUSH	H		;SAVE REGS
	PUSH	D
	PUSH	B
	MVI	E,0FFH		;GET CHAR IF ANY
	MVI	C,6		;CONSOLE STATUS CHECK
	CALL	BDOS
	POP	B		;RESTORE REGS
	POP	D
	POP	H
	CPI	CTRLC		;CHECK FOR ABORT
	JZ	EXIT		;EXIT
	CPI	CTRLX		;SKIP?
	RET

;
; COPY HL TO DE FOR B BYTES
;
LDIR:
	MOV	A,M	;GET
	STAX	D	;PUT
	INX	H	;PT TO NEXT
	INX	D
	DJNZ	LDIR	;LOOP
	RET

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

;
;  OUTPUT NEW LINE TO CON:
;
CRLF:
	MVI	A,CR
	CALL	CONOUT
	MVI	A,LF
	JMP	CONOUT

;
; SEARCH FOR FIRST AND NEXT
;
SEARF:
	PUSH	B	; SAVE COUNTER
	PUSH	H	; SAVE HL
	MVI	C,17	; SEARCH FOR FIRST FUNCTION
SEARF1:
	LXI	D,FCB1	; PT TO FCB
	CALL	BDOS
	INR	A	; SET ZERO FLAG FOR ERROR RETURN
	POP	H	; GET HL
	POP	B	; GET COUNTER
	RET
SEARN:
	PUSH	B	; SAVE COUNTER
	PUSH	H	; SAVE HL
	MVI	C,18	; SEARCH FOR NEXT FUNCTION
	JR	SEARF1

;
; CONSOLE INPUT
;
CONIN:
	PUSH	H	; SAVE REGS
	PUSH	D
	PUSH	B
	MVI	C,1	; INPUT
	CALL	BDOS
	POP	B	; GET REGS
	POP	D
	POP	H
	ANI	7FH	; MASK MSB
	CPI	61H
	RC
	ANI	5FH	; TO UPPER CASE
	RET

;
; LOG INTO USER AREA CONTAINED IN FCB1
;
LOGUSR:
	LDA	FCB1+13		;GET USER NUMBER
SETUSR:
	MOV	E,A
	MVI	C,32		;USE BDOS FCT
	JMP	BDOS

;
;  PRINT FILE NAME PTED TO BY HL
;
PRFN:
	CALL	PRINT	;LEADING SPACE
	DB	' '+80H
	MVI	B,8	;8 CHARS
	CALL	PRFN1
	MVI	A,'.'	;DOT
	CALL	CONOUT
	MVI	B,3	;3 CHARS
PRFN1:
	MOV	A,M	; GET CHAR
	INX	H	; PT TO NEXT
	CALL	CONOUT	; PRINT CHAR
	DJNZ	PRFN1	; COUNT DOWN
	RET

;
; SAVE RETURN ADDRESS
;
RETSAVE:
	POP	D	; GET RETURN ADDRESS
	POP	H	; GET RETURN ADDRESS TO ZCPR3
	SHLD	Z3RET	; SAVE IT
	PUSH	H	; PUT RETURN ADDRESS TO ZCPR3 BACK
	PUSH	D	; PUT RETURN ADDRESS BACK
	RET

;
; EXIT TO ZCPR3
;
EXIT:
Z3RET	EQU	$+1	; POINTER TO IN-THE-CODE MODIFICATION
	LXI	H,0	; RETURN ADDRESS
	PCHL		; 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:
	LDA	Z3WHL	;GET WHEEL BYTE
	ORA	A	;ZERO?
	RNZ
	POP	PSW	;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
	MOV	A,D	;PRINT HIGH
	CALL	PAHC
	MOV	A,E	;PRINT LOW
	JMP	PAHC
;
; EXTRACT HEXADECIMAL NUMBER FROM LINE PTED TO BY HL
;   RETURN WITH VALUE IN DE AND HL PTING TO OFFENDING CHAR
;
HEXNUM:
	LXI	D,0		;DE=ACCUMULATED VALUE
	MVI	B,5		;B=CHAR COUNT
HNUM1:
	MOV	A,M		;GET CHAR
	CPI	' '+1		;DONE?
	RC			;RETURN IF SPACE OR LESS
	INX	H		;PT TO NEXT
	SUI	'0'		;CONVERT TO BINARY
	JRC	NUMERR		;RETURN AND DONE IF ERROR
	CPI	10		;0-9?
	JRC	HNUM2
	SUI	7		;A-F?
	CPI	10H		;ERROR?
	JRNC	NUMERR
HNUM2:
	MOV	C,A		;DIGIT IN C
	MOV	A,D		;GET ACCUMULATED VALUE
	RLC			;EXCHANGE NYBBLES
	RLC
	RLC
	RLC
	ANI	0F0H		;MASK OUT LOW NYBBLE
	MOV	D,A
	MOV	A,E		;SWITCH LOW-ORDER NYBBLES
	RLC
	RLC
	RLC
	RLC
	MOV	E,A		;HIGH NYBBLE OF E=NEW HIGH OF E,
				;  LOW NYBBLE OF E=NEW LOW OF D
	ANI	0FH		;GET NEW LOW OF D
	ORA	D		;MASK IN HIGH OF D
	MOV	D,A		;NEW HIGH BYTE IN D
	MOV	A,E
	ANI	0F0H		;MASK OUT LOW OF E
	ORA	C		;MASK IN NEW LOW
	MOV	E,A		;NEW LOW BYTE IN E
	DJNZ	HNUM1		;COUNT DOWN
	RET
;
; NUMBER ERROR
;
NUMERR:
	CALL	PRINT
	DB	' Num','?'+80H
	JMP	EXIT
;
; SKIP TO NEXT NON-BLANK
;
SKSP:
	MOV	A,M	;GET CHAR
	INX	H	;PT TO NEXT
	CPI	' '	;SKIP SPACES
	JRZ	SKSP
	DCX	H	;PT TO GOOD CHAR
	ORA	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
	JRZ	EXOK		;OK IF NOT FOUND
	CALL	GETSBIT		;POSITION INTO DIR
	INX	D		;PT TO FILE NAME
	XCHG			;HL PTS TO FILE NAME
	PUSH	H		;SAVE PTR TO FILE NAME
	CALL	PRFN		;PRINT FILE NAME
	POP	H
	CALL	ROTEST		;CHECK FOR R/O
	JRNZ	EXER
	CALL	ERAQ		;ERASE?
	JRNZ	EXER		;RESTART AS ERROR IF NO
	LXI	D,FCB1		;PT TO FCB1
	MVI	C,19		;DELETE FILE
	CALL	BDOS
EXOK:
	XRA	A
	DCR	A		;NZ = OK
	RET
EXER:
	XRA	A		;ERROR FLAG - FILE IS R/O OR NO PERMISSION
	RET

;
; CHECK FOR AMBIGUOUS FILE NAME IN FCB1
;   RETURN Z IF SO
;
AMBCHK:
	LXI	H,FCB1+1	;PT TO FCB
;
; CHECK FOR AMBIGUOUS FILE NAME PTED TO BY HL
;
AMBCHK1:
	PUSH	H
	MVI	B,11		;11 BYTES
AMB1:
	MOV	A,M		;GET CHAR
	ANI	7FH		;MASK
	CPI	'?'
	JRZ	AMB2
	INX	H		;PT TO NEXT
	DJNZ	AMB1
	DCR	B		;SET NZ FLAG
	POP	D
	RET
AMB2:
	POP	H		;PT TO FILE NAME
	CALL	PRFN
	CALL	PRINT
	DB	' is AF','N'+80H
	JMP	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
	CPI	'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	H	;ADVANCE TO R/O BYTE
	LXI	B,8	;PT TO 9TH BYTE
	DAD	B
	MOV	A,M	;GET IT
	ANI	80H	;MASK BIT
	PUSH	PSW
	LXI	H,ROMSG
	CNZ	PRINT1	;PRINT IF NZ
	POP	PSW	;GET FLAG
	POP	H	;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:
	LXI	H,FCB1		;PT TO FCB
INITFCB2:
	PUSH	H		;SAVE PTR
	LXI	B,12		;PT TO FIRST BYTE
	DAD	B
	MVI	B,24		;ZERO 24 BYTES
	XRA	A		;ZERO FILL
	CALL	FILLP		;FILL MEMORY
	POP	D		;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))
SIZERR	EQU	NOVALUE	;RCP IS TOO LARGE FOR BUFFER
	ENDIF

;
; END OF SYS.RCP
;

	END