*************************************************************************
*									*
*  Z C P R 2 -- Z80-Based Command Processor Replacement, Version 2.0	*
*									*
*  Copyright (c) 1982, 1983 by Richard Conn				*
*  All Rights Reserved							*
*									*
*  ZCPR2 was written by Richard Conn, who assumes no responsibility	*
*  or liability for its use.  ZCPR2 is released to the public   	*
*  domain for non-commercial use only.					*
*									*
*  The public is encouraged to freely copy and use this program for	*
*  non-commercial purposes.  Any commercial use of ZCPR2 is prohibited	*
*  unless approved by the author, Richard Conn, in writing.		*
*									*
*  This is Mod 0.3 to the RELEASE VERSION of ZCPR2.			*
*									*
*************************************************************************

;
;  ZCPR2 -- CP/M Z80 Command Processor Replacement (ZCPR) Version 2.0
;
;	ZCPR2 is based upon ZCPR
;
;	ZCPR2 was an individual effort by Richard Conn, with comments,
; recommendations, and some beta testing by the following people:
;		Frank Wancho
;		Charlie Strom
;		Hal Carter
;
;	Extensive documentation on ZCPR2 and the utilities in the ZCPR2
; System can be found in the following manuals:
;		ZCPR2 Concepts Manual
;		ZCPR2 Installation Manual
;		ZCPR2 User's Guide
;		ZCPR2 Rationale
;
;******** Structure Notes ********
;
;	ZCPR2 is divided into a number of major sections.  The following
; is an outline of these sections and the names of the major routines
; located therein.
;
; Section	Function/Routines
; -------	-----------------
;
;   --		Opening Comments, Equates, and Macro Definitions
;
;    0		JMP Table into ZCPR2
;
;    1		Buffers
;
;    2		CPR Starting Modules
;			CPR1	CPR	CONT	RESTRT	RS1
;			CAPBUF	RSTCPR	RCPRNL	ERROR	PRNNF
;
;    3		Utilities
;			CRLF	CONOUT	CONIN	LCOUT	LSTOUT
;			PAGER	READF	READ	BDOSB	PRINTC
;			PRINT	PRIN1	GETDRV	DEFDMA	DMASET
;			RESET	BDOSJP	LOGIN	OPENF	OPEN
;			GRBDOS	CLOSE	SEARF	SEAR1	SEARN
;			SUBKIL	DELETE	GETUSR	SETUSR
;
;     4		CPR Utilities
;			SETUD	UCASE	REDBUF	BREAK	SDELM
;			ADVAN	SBLANK	ADDAH	NUMBER	NUMERR
;			HEXNUM	DIRPTR	SLOGIN	DLOGIN	SCANLOG
;			SCANER	SCANX	SCANF	CMDSER
;
;     5		CPR-Resident Commands and Functions
;     5A		DIR	DIRPR	PRFN	GETSBIT	FILLQ
;     5B		ERA
;     5C		LIST
;     5D		TYPE
;     5E		SAVE	EXTEST
;     5F		REN
;     5G		JUMP
;     5H		GO
;     5I		COM	CALLPROG
;     5J		GET	MLOAD	PRNLE	PATH
;
;
FALSE	EQU	0
TRUE	EQU	NOT FALSE
;
;  The following MACLIB statement loads all the user-selected equates
; which are used to customize ZCPR2 for the user's working environment.
;
	MACLIB	ZCPRHDR
;
CR	EQU	0DH
LF	EQU	0AH
TAB	EQU	09H
;
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
TBUFF	EQU	BASE+0080H		;DEFAULT DISK I/O BUFFER
TPA	EQU	BASE+0100H		;BASE OF TPA
;
;
; MACROS TO PROVIDE Z80 EXTENSIONS
;   MACROS INCLUDE:
;
$-MACRO 		;FIRST TURN OFF THE EXPANSIONS
;
;	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
;	LDIR	- MOV @HL TO @DE FOR COUNT IN BC
;	LXXD	- LOAD DOUBLE REG DIRECT
;	SXXD	- STORE DOUBLE REG DIRECT
;	EXX	- EXCHANGE BC, DE, HL WITH BC', DE', HL'
;
;
;
;	@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
;
JR	MACRO	?N	;;JUMP RELATIVE
	DB	18H
	@GENDD	?N-$-1
	ENDM
;
JRC	MACRO	?N	;;JUMP RELATIVE ON CARRY
	DB	38H
	@GENDD	?N-$-1
	ENDM
;
JRNC	MACRO	?N	;;JUMP RELATIVE ON NO CARRY
	DB	30H
	@GENDD	?N-$-1
	ENDM
;
JRZ	MACRO	?N	;;JUMP RELATIVE ON ZERO
	DB	28H
	@GENDD	?N-$-1
	ENDM
;
JRNZ	MACRO	?N	;;JUMP RELATIVE ON NO ZERO
	DB	20H
	@GENDD	?N-$-1
	ENDM
;
DJNZ	MACRO	?N	;;DECREMENT B AND JUMP RELATIVE ON NO ZERO
	DB	10H
	@GENDD	?N-$-1
	ENDM
;
LDIR	MACRO		;;LDIR
	DB	0EDH,0B0H
	ENDM
;
LDED	MACRO	?N	;;LOAD DE DIRECT
	DB	0EDH,05BH
	DW	?N
	ENDM
;
LBCD	MACRO	?N	;;LOAD BC DIRECT
	DB	0EDH,4BH
	DW	?N
	ENDM
;
SDED	MACRO	?N	;;STORE DE DIRECT
	DB	0EDH,53H
	DW	?N
	ENDM
;
SBCD	MACRO	?N	;;STORE BC DIRECT
	DB	0EDH,43H
	DW	?N
	ENDM
;
EXX	MACRO		;;EXCHANGE PRIMARY AND ALTERNATE REGISTERS
	DB	0D9H
	ENDM
;
; END OF Z80 MACRO EXTENSIONS
;
;
;**** Section 0 ****
;
	ORG	CPRLOC
;
;  ENTRY POINTS INTO ZCPR2
;
;    IF MULTCMD (MULTIPLE COMMANDS ON ONE LINE) is FALSE:
;    If ZCPR2 is entered at location CPRLOC (at the JMP to CPR), then
; the default command in CMDLIN will be processed.  If ZCPR2 is entered
; at location CPRLOC+3 (at the JMP to CPR1), then the default command in
; CMDLIN will NOT be processed.
;    NOTE:  Entry into ZCPR2 at CPRLOC is permitted, but in order for this
; to work, CMDLIN MUST be initialized to contain the command line (ending in 0)
; and the C register MUST contain a valid User/Disk Flag
; (the most significant nybble contains the User Number and the least
; significant nybble contains the Disk Number).
;    Some user programs (such as SYNONYM3) attempt to use the default
; command facility.  Under the original CPR, it was necessary to initialize
; the pointer after the reserved space for the command buffer to point to
; the first byte of the command buffer.  The NXTCHR (NeXT CHaRacter pointer)
; is located to be compatable with such programs (if they determine the buffer
; length from the byte at BUFSIZ [CPRLOC + 6]), but under ZCPR2
; this is no longer necessary.  ZCPR2 automatically initializes
; this buffer pointer in all cases if MULTCMD is not enabled.
;
;    IF MULTCMD is TRUE:
;    Entry at CPR or CPR1 has the same effect.  Multiple command processing
; will still continue.
;    Hence, if MULTCMD is FALSE, a user program need only load the buffer
; CMDLIN with the desired command line, terminated by a zero, in order to
; have this command line executed.  If MULTCMD is TRUE, a user program must
; load this buffer as before, but he must also set the NXTCHR pointer to
; point to the first character of the command line.
;    NOTE:  ***** (BIG STAR) ***** Programs such as SYNONYM3 will fail if
; multiple commands are enabled, but this feature is so very useful that I
; feel it is worth the sacrifice.  The ZCPR2 utilities of STARTUP and MENU
; require multiple commands, and this feature also permits simple chaining
; of programs to be possible under the ZCPR2 environment.
;
;	Enjoy using ZCPR2!
;			Richard Conn
;
ENTRY:
	JMP	CPR	; Process potential default command
	JMP	CPR1	; Do NOT process potential default command
;
;**** Section 1 ****
; BUFFERS ET AL
;
; INPUT COMMAND LINE AND DEFAULT COMMAND
;   The command line to be executed is stored here.  This command line
; is generated in one of three ways:
;	(1) by the user entering it through the BDOS READLN function at
; the du> prompt [user input from keyboard]
;	(2) by the SUBMIT File Facility placing it there from a $$$.SUB
; file
;	(3) by an external program or user placing the required command
; into this buffer
;   In all cases, the command line is placed into the buffer starting at
; CMDLIN.  This command line is terminated by a binary zero.  ZCPR2 then
; parses, interprets, and executes the command line.
;   Case is not significant in the command line.  ZCPR2 converts all lower-case
; letters to upper-case.
;   If MULTCMD is TRUE, then the user must set a pointer to the first
; character of the command line into the buffer NXTCHR.  If MULTCMD is FALSE,
; no action other than placing a zero-terminated command line into the buffer
; starting at CMDLIN is required on the part of the user.
;
	IF	MULTCMD		;MULTIPLE COMMANDS ALLOWED?
;
; For Multiple Commands, the command line buffer (CMDLIN) is located external
; to ZCPR2 so that it is not overlayed during Warm Boots; the same is true
; for NXTCHR, the 2nd key buffer.  BUFSIZ and CHRCNT are not important and
; are provided so the BDOS READLN function can load CMDLIN directly and
; a user program can see how much space is available in CMDLIN for its text.
;
NXTCHR	EQU	CLBASE		;NXTCHR STORED EXTERNALLY (2 bytes)
BUFSIZ	EQU	NXTCHR+2	;BUFSIZ STORED EXTERNALLY (1 byte)
CHRCNT	EQU	BUFSIZ+1	;CHRCNT STORED EXTERNALLY (1 byte)
CMDLIN	EQU	CHRCNT+1	;CMDLIN STORED EXTERNALLY (long)
;
	ELSE
;
; If no multiple commands are permitted, these buffers are left internal
; to ZCPR2 so that the original CCP command line facility (as used by
; programs like SYNONYM3) can be left intact.
;
BUFLEN	EQU	80		;MAXIMUM BUFFER LENGTH
BUFSIZ:
	DB	BUFLEN		;MAXIMUM BUFFER LENGTH
CHRCNT:
	DB	0		;NUMBER OF VALID CHARS IN COMMAND LINE
CMDLIN:
	DB	'               '	;DEFAULT (COLD BOOT) COMMAND
	DB	0			;COMMAND STRING TERMINATOR
	DS	BUFLEN-($-CMDLIN)+1	;TOTAL IS 'BUFLEN' BYTES
;
NXTCHR:
	DW	CMDLIN		;POINTER TO COMMAND INPUT BUFFER
;
	ENDIF		;MULTCMD
;

;
; FILE TYPE FOR COMMAND
;
COMMSG:
	COMTYP			;USE MACRO FROM ZCPRHDR.LIB
;
	IF	SUBON		;IF SUBMIT FACILITY ENABLED ...
;
; SUBMIT FILE CONTROL BLOCK
;
SUBFCB:
	DB	1		;DISK NAME SET TO DEFAULT TO DRIVE A:
	DB	'$$$'		;FILE NAME
	DB	'     '
	SUBTYP			;USE MACRO FROM ZCPRHDR.LIB
	DB	0		;EXTENT NUMBER
	DB	0		;S1
SUBFS2:
	DS	1		;S2
SUBFRC:
	DS	1		;RECORD COUNT
	DS	16		;DISK GROUP MAP
SUBFCR:
	DS	1		;CURRENT RECORD NUMBER
;
	ENDIF		;SUBON
;
; COMMAND FILE CONTROL BLOCK
;
	IF	EXTFCB		;MAY BE PLACED EXTERNAL TO ZCPR2
;
FCBDN	EQU	FCBADR		;DISK NAME
FCBFN	EQU	FCBDN+1		;FILE NAME
FCBFT	EQU	FCBFN+8		;FILE TYPE
FCBDM	EQU	FCBFT+7		;DISK GROUP MAP
FCBCR	EQU	FCBDM+16	;CURRENT RECORD NUMBER
;
	ELSE			;OR INTERNAL TO ZCPR2
;
FCBDN:
	DS	1		;DISK NAME
FCBFN:
	DS	8		;FILE NAME
FCBFT:
	DS	3		;FILE TYPE
	DS	1		;EXTENT NUMBER
	DS	2		;S1 AND S2
	DS	1		;RECORD COUNT
FCBDM:
	DS	16		;DISK GROUP MAP
FCBCR:
	DS	1		;CURRENT RECORD NUMBER
;
	ENDIF		;EXTFCB
;

;
; LINE COUNT BUFFER
;
PAGCNT:
	DB	NLINES-2	;LINES LEFT ON PAGE

;
; CPR COMMAND NAME TABLE
;   EACH TABLE ENTRY IS COMPOSED OF THE 4-BYTE COMMAND AND 2-BYTE ADDRESS
;
CMDTBL:
	CTABLE		;DEFINE COMMAND TABLE VIA MACRO IN ZCPRHDR FILE
;
NCMNDS	EQU	($-CMDTBL)/(NCHARS+2)
;

;
;**** Section 2 ****
; ZCPR2 STARTING POINTS
;
; START ZCPR2 AND DON'T PROCESS DEFAULT COMMAND STORED IF MULTIPLE COMMANDS
; ARE NOT ALLOWED
;
CPR1:
;
	IF	NOT MULTCMD	;IF MULTIPLE COMMANDS NOT ALLOWED
;
	XRA	A		;SET END OF COMMAND LINE SO NO DEFAULT COMMAND
	STA	CMDLIN		;FIRST CHAR OF BUFFER
;
	ENDIF		;NOT MULTCMD
;
; START ZCPR2 AND POSSIBLY PROCESS DEFAULT COMMAND
;
; NOTE ON MODIFICATION BY Ron Fowler:  BDOS RETURNS 0FFH IN
; ACCUMULATOR WHENEVER IT LOGS IN A DIRECTORY, IF ANY
; FILE NAME CONTAINS A '$' IN IT.  THIS IS NOW USED AS
; A CLUE TO DETERMINE WHETHER OR NOT TO DO A SEARCH
; FOR SUBMIT FILE, IN ORDER TO ELIMINATE WASTEFUL SEARCHES.
;
CPR:
	LXI	SP,STACK	;RESET STACK
;
	IF	NOT MULTCMD	;ONLY ONE COMMAND PERMITTED
;
	LXI	H,CMDLIN	;SET PTR TO BEGINNING OF COMMAND LINE
	SHLD	NXTCHR
;
	ENDIF		;NOT MULTCMD
;
	PUSH	B
	MOV	A,C		;C=USER/DISK NUMBER (SEE LOC 4)
	RAR			;EXTRACT USER NUMBER
	RAR
	RAR
	RAR
	ANI	0FH
	STA	CURUSR		;SET USER
	CALL	SETUSR		;SET USER NUMBER
	CALL	RESET		;RESET DISK SYSTEM
;
	IF	SUBON		;IF SUBMIT FACILITY ENABLED
;
	STA	RNGSUB		;SAVE SUBMIT CLUE FROM DRIVE A:
;
	ENDIF		;SUBON
;
	POP	B
	MOV	A,C		;C=USER/DISK NUMBER (SEE LOC 4)
	ANI	0FH		;EXTRACT CURRENT DISK DRIVE
	STA	CURDR		;SET IT
	CNZ	LOGIN		;LOG IN DEFAULT DISK IF NOT ALREADY LOGGED IN
	CALL	SETUD		;SET USER/DISK FLAG
	CALL	DEFDMA		;SET DEFAULT DMA ADDRESS
;
	IF	SUBON		;CHECK FOR $$$.SUB IF SUBMIT FACILITY IS ON
;
	LXI	D,SUBFCB	;CHECK FOR $$$.SUB ON CURRENT DISK
RNGSUB	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;2ND BYTE (IMMEDIATE ARG) IS THE RNGSUB FLAG
	ORA	A		;SET FLAGS ON CLUE
	CNZ	SEAR1
	STA	RNGSUB		;SET FLAG (0=NO $$$.SUB)
;
	ENDIF		;SUBON
;
	IF	MULTCMD
;
;  TEST FOR NEXT COMMAND IN CONT LOOP IF MULTIPLE COMMAND LINE BUFFER
;	IS ENABLED
;
CONT:
;
	ENDIF		;MULTCMD
;
	LHLD	NXTCHR		;PT TO NEXT CHARACTER TO PROCESS
	MOV	A,M		;GET IT
	CPI	3		;RESTART IF ^C
	JRZ	RESTRT
	ORA	A		;0 IF NO COMMAND LINE PRESENT
	JRNZ	RS1
;
	IF	NOT MULTCMD
;
;  TEST FOR ANY DEFAULT COMMAND BEFORE CONT LOOP IS
;	ENTERED IF MULTIPLE COMMAND LINE BUFFER IS DISABLED
;
CONT:
;
	ENDIF		;NOT MULTCMD
;
; PROMPT USER AND INPUT COMMAND LINE FROM HIM
;
RESTRT:
	LXI	SP,STACK	;RESET STACK
;
; PRINT PROMPT (DU>)
;
	CALL	CRLF		;PRINT PROMPT
;
	IF	DUPRMPT		;IF DRIVE IN PROMPT
	LDA	CURDR		;CURRENT DRIVE IS PART OF PROMPT
	ADI	'A'		;CONVERT TO ASCII A-P
	CALL	CONOUT
;
	LDA	CURUSR		;GET USER NUMBER
;
	IF	SUPRES		;IF SUPPRESSING USR # REPORT FOR USR 0
;
	ORA	A
	JRZ	RS000
;
	ENDIF		;SUPRES
;
	CPI	10		;USER < 10?
	JRC	RS00
	SUI	10		;SUBTRACT 10 FROM IT
	PUSH	PSW		;SAVE IT
	MVI	A,'1'		;OUTPUT 10'S DIGIT
	CALL	CONOUT
	POP	PSW
RS00:
	ADI	'0'		;OUTPUT 1'S DIGIT (CONVERT TO ASCII)
	CALL	CONOUT
;
	ENDIF		;DUPRMPT
;
; READ INPUT LINE FROM USER OR $$$.SUB
;
RS000:
	LXI	H,CMDLIN	;SET POINTER TO FIRST CHAR IN COMMAND LINE
	SHLD	NXTCHR		;POINTER TO NEXT CHARACTER TO PROCESS
	MVI	M,0		;ZERO OUT COMMAND LINE IN CASE OF WARM BOOT
	PUSH	H		;SAVE PTR
	CALL	REDBUF		;INPUT COMMAND LINE FROM USER (OR $$$.SUB)
	POP	H		;GET PTR
	MOV	A,M		;CHECK FOR COMMENT LINE
	CPI	COMMENT		;BEGINS WITH COMMENT CHAR?
	JRZ	RESTRT		;INPUT ANOTHER LINE IF SO
	ORA	A		;NO INPUT?
	JRZ	RESTRT
;
; PROCESS INPUT LINE; HL PTS TO FIRST LETTER OF COMMAND
;
RS1:
	LXI	SP,STACK	;RESET STACK
;
	IF	MULTCMD		;MULTIPLE COMMANDS ALLOWED?
;
	MOV	A,M		;GET FIRST CHAR OF COMMAND
	CPI	CMDSEP		;IS IT A COMMAND SEPARATOR?
	JRNZ	RS2
	INX	H		;SKIP IT IF IT IS
	SHLD	NXTCHR		;SET PTR BACK
;
	ENDIF		;MULTCMD
;
; SET POINTER FOR MULTIPLE COMMAND LINE PROCESSING TO FIRST CHAR OF NEW CMND
;
RS2:
	SHLD	CMDCH1		;SET PTR TO FIRST CHAR OF NEW COMMAND LINE
;
; CAPITALIZE COMMAND LINE
;
CAPBUF:
	MOV	A,M		;CAPITALIZE COMMAND CHAR
	CALL	UCASE
	MOV	M,A
	INX	H		;PT TO NEXT CHAR
	ORA	A		;EOL?
	JRNZ	CAPBUF
	CALL	SCANER		;PARSE COMMAND NAME FROM COMMAND LINE
	JRNZ	ERROR		;ERROR IF COMMAND NAME CONTAINS A '?'
	LXI	D,RSTCPR	;PUT RETURN ADDRESS OF COMMAND
	PUSH	D		;ON THE STACK
COLON	EQU	$+1		;FLAG FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;COMMAND OF THE FORM 'DU:COMMAND'?
	ORA	A		;0=NO
	JNZ	COM		;PROCESS AS COM FILE IF NOT
	CALL	CMDSER		;SCAN FOR CPR-RESIDENT COMMAND
	JNZ	COM		;NOT CPR-RESIDENT
	MOV	A,M		;FOUND IT:  GET LOW-ORDER PART
	INX	H		;GET HIGH-ORDER PART
	MOV	H,M		;STORE HIGH
	MOV	L,A		;STORE LOW
	PCHL			;EXECUTE CPR ROUTINE
;
; ENTRY POINT FOR RESTARTING CPR AND LOGGING IN DEFAULT DRIVE
;
RSTCPR:
	CALL	DLOGIN		;LOG IN CURRENT USER/DISK
;
; ENTRY POINT FOR RESTARTING CPR WITHOUT LOGGING IN DEFAULT DRIVE
;
RCPRNL:
	CALL	SCANER		;EXTRACT NEXT TOKEN FROM COMMAND LINE
	LDA	FCBFN		;GET FIRST CHAR OF TOKEN
	CPI	' '		;ANY CHAR?
	JZ	CONT		;CONTINUE WITH NEXT COMMAND IF NO ERROR

;
; INVALID COMMAND -- PRINT IT
;
ERROR:
	CALL	CRLF		;NEW LINE
CURTOK	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	LXI	H,0		;PT TO BEGINNING OF COMMAND LINE
ERR1:
	MOV	A,M		;GET CHAR
	CPI	' '+1		;SIMPLE '?' IF <SP> OR LESS
	JRC	ERR2
	CALL	CONOUT		;PRINT COMMAND CHAR
	INX	H		;PT TO NEXT CHAR
	JR	ERR1		;CONTINUE
ERR2:
	CALL	PRINT		;PRINT '?'
	DB	'?'+80H
ERR3:
	CALL	DLOGIN		;PANIC RESTORE OF DEFAULT USER/DISK
;
	IF	SUBON		;IF SUBMIT FACILITY IS ON
;
	CALL	SUBKIL		;TERMINATE ACTIVE $$$.SUB IF ANY
;
	ENDIF		;SUBON
;
	JMP	RESTRT		;RESTART CPR

;
; No File Error Message
;
PRNNF:
	CALL	PRINTC		;NO FILE MESSAGE
	DB	'No Fil','e'+80H
	RET
;
;**** Section 3 ****
; I/O UTILITIES
;
; OUTPUT CHAR IN REG A TO CONSOLE AND DON'T CHANGE BC
;
;
; OUTPUT <CRLF>
;
CRLF:
	MVI	A,CR
	CALL	CONOUT
	MVI	A,LF
	JR	CONOUT
;
CONIN:
	MVI	C,1	;INPUT CHAR
	CALL	BDOS	;GET INPUT CHAR WITH ^S PROCESSING AND ECHO
	JMP	UCASE	;CAPITALIZE
;
CONOUT:
	EXX
	MVI	C,2
OUTPUT:
	MOV	E,A
	CALL	BDOS
	EXX
	RET
;
LCOUT:
	PUSH	PSW	;OUTPUT CHAR TO CON: OR LST: DEP ON PRFLG
PRFLG	EQU	$+1	;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0	;2ND BYTE (IMMEDIATE ARG) IS THE PRINT FLAG
	ORA	A	;0=TYPE
	JRZ	LC1
	POP	PSW	;GET CHAR
;
; OUTPUT CHAR IN REG A TO LIST DEVICE
;
LSTOUT:
	EXX		;SAVE REGS
	MVI	C,5
	JR	OUTPUT
LC1:
	POP	PSW	;GET CHAR
	PUSH	PSW
	CALL	CONOUT	;OUTPUT TO CON:
	POP	PSW
	CPI	LF	;CHECK FOR PAGING
	RNZ
;
; PAGING ROUTINES
;   PAGER COUNTS DOWN LINES AND PAUSES FOR INPUT (DIRECT) IF COUNT EXPIRES
;   PAGSET SETS LINES/PAGE COUNT
;
PAGER:
	PUSH	H
	LXI	H,PAGCNT	;COUNT DOWN
	DCR	M
	JRNZ	PAGER1		;JUMP IF NOT END OF PAGE
	MVI	M,NLINES-2	;REFILL COUNTER
;
PGFLG	EQU	$+1		;POINTER TO IN-THE-CODE BUFFER PGFLG
	MVI	A,0		;0 MAY BE CHANGED BY PGFLG EQUATE
	CPI	PGDFLG		;PAGE DEFAULT OVERRIDE OPTION WANTED?
;
	IF	PGDFLT		;IF PAGING IS DEFAULT
;
	JRZ	PAGER1		;  PGDFLG MEANS NO PAGING, PLEASE
;
	ELSE			;IF PAGING NOT DEFAULT
;
	JRNZ	PAGER1		;  PGDFLG MEANS PLEASE PAGINATE
;
	ENDIF		;PGDFLG
;
	PUSH	B		;SAVE REG
	CALL	BIOS+9		;BIOS CONSOLE INPUT ROUTINE
	POP	B		;GET REG
	CPI	'C'-'@' 	;^C
	JZ	RSTCPR		;RESTART CPR
PAGER1:
	POP	H		;RESTORE HL
	RET
;
; READ FILE BLOCK FUNCTION
;
READF:
	LXI	D,FCBDN ;FALL THRU TO READ
READ:
	MVI	C,14H	;FALL THRU TO BDOSB
;
; CALL BDOS AND SAVE BC
;
BDOSB:
	PUSH	B
	CALL	BDOS
	POP	B
	ORA	A
	RET
;
; PRINT STRING (ENDING IN CHAR WITH MSB SET) PTED TO BY RET ADR
; START WITH <CRLF>
;
PRINTC:
	CALL	CRLF		;NEW LINE
;
PRINT:
	XTHL			;GET PTR TO STRING
	CALL	PRIN1		;PRINT STRING
	XTHL			;RESTORE HL AND RET ADR
	RET
;
; PRINT STRING (ENDING IN 0 OR BYTE WITH MSB SET) PTED TO BY HL
;
PRIN1:
	MOV	A,M		;GET NEXT BYTE
	INX	H		;PT TO NEXT BYTE
	ORA	A		;END OF STRING?
	RZ			;STRING TERMINATED BY BINARY 0
	PUSH	PSW		;SAVE FLAGS
	ANI	7FH		;MASK OUT MSB
	CALL	CONOUT		;PRINT CHAR
	POP	PSW		;GET FLAGS
	RM			;STRING TERMINATED BY MSB SET
	JR	PRIN1
;
; BDOS FUNCTION ROUTINES
;
;
; RETURN NUMBER OF CURRENT DISK IN A
;
GETDRV:
	MVI	C,19H
	JR	BDOSJP
;
; SET 80H AS DMA ADDRESS
;
DEFDMA:
	LXI	D,TBUFF 	;80H=TBUFF
DMASET:
	MVI	C,1AH
	JR	BDOSJP
;
RESET:
	MVI	C,0DH
BDOSJP:
	JMP	BDOS
;
LOGIN:
	MOV	E,A
	MVI	C,0EH
	JR	BDOSJP	;SAVE SOME CODE SPACE
;
OPENF:
	XRA	A
	STA	FCBCR
	LXI	D,FCBDN ;FALL THRU TO OPEN
;
OPEN:
	MVI	C,0FH	;FALL THRU TO GRBDOS
;
GRBDOS:
	CALL	BDOS
	INR	A	;SET ZERO FLAG FOR ERROR RETURN
	RET
;
CLOSE:
	MVI	C,10H
	JR	GRBDOS
;
SEARF:
	LXI	D,FCBDN ;SPECIFY FCB
SEAR1:
	MVI	C,11H
	JR	GRBDOS
;
SEARN:
	MVI	C,12H
	JR	GRBDOS
;
; CHECK FOR SUBMIT FILE IN EXECUTION AND ABORT IT IF SO
;
	IF	SUBON		;ENABLE ONLY IF SUBMIT FACILITY IS ENABLED
;
SUBKIL:
	LXI	H,RNGSUB	;CHECK FOR SUBMIT FILE IN EXECUTION
	MOV	A,M
	ORA	A		;0=NO
	RZ
	MVI	M,0		;ABORT SUBMIT FILE
	LXI	D,SUBFCB	;DELETE $$$.SUB
;
	ENDIF		;SUBON
;
DELETE:
	MVI	C,13H
	JR	BDOSJP	;SAVE MORE SPACE
;
;  GET/SET USER NUMBER
;
GETUSR:
	MVI	A,0FFH		;GET CURRENT USER NUMBER
SETUSR:
	MOV	E,A		;USER NUMBER IN E
	MVI	C,20H		;SET USER NUMBER TO VALUE IN E (GET IF E=FFH)
	JR	BDOSJP		;MORE SPACE SAVING
;
; END OF BDOS FUNCTIONS
;
;
;**** Section 4 ****
; ZCPR2 UTILITIES
;
; SET USER/DISK FLAG TO CURRENT USER AND DEFAULT DISK
;
SETUD:
	CALL	GETUSR		;GET NUMBER OF CURRENT USER
	ANI	0FH		;MASK SURE 4 BITS
	ADD	A		;PLACE IT IN HIGH NYBBLE
	ADD	A
	ADD	A
	ADD	A
	LXI	H,CURDR		;MASK IN CURRENT DRIVE NUMBER (LOW NYBBLE)
	ORA	M		;MASK IN
	STA	UDFLAG		;SET USER/DISK NUMBER
	RET
;
; CONVERT CHAR IN A TO UPPER CASE
;
UCASE:
	ANI	7FH		;MASK OUT MSB
	CPI	61H		;LOWER-CASE A
	RC
	CPI	7BH		;GREATER THAN LOWER-CASE Z?
	RNC
	ANI	5FH		;CAPITALIZE
	RET
;
; INPUT NEXT COMMAND TO CPR
;	This routine determines if a SUBMIT file is being processed
; and extracts the command line from it if so or from the user's console
;
REDBUF:
;
	IF	SUBON		;IF SUBMIT FACILITY IS ENABLED, CHECK FOR IT
;
	LDA	RNGSUB		;SUBMIT FILE CURRENTLY IN EXECUTION?
	ORA	A		;0=NO
	JRZ	RB1		;GET LINE FROM CONSOLE IF NOT
	LXI	D,SUBFCB	;OPEN $$$.SUB
	PUSH	D		;SAVE DE
	CALL	OPEN
	POP	D		;RESTORE DE
	JRZ	RB1		;ERASE $$$.SUB IF END OF FILE AND GET CMND
	LDA	SUBFRC		;GET VALUE OF LAST RECORD IN FILE
	DCR	A		;PT TO NEXT TO LAST RECORD
	STA	SUBFCR		;SAVE NEW VALUE OF LAST RECORD IN $$$.SUB
	CALL	READ		;DE=SUBFCB
	JRNZ	RB1		;ABORT $$$.SUB IF ERROR IN READING LAST REC
	LXI	D,CHRCNT 	;COPY LAST RECORD (NEXT SUBMIT CMND) TO CHRCNT
	LXI	H,TBUFF 	;  FROM TBUFF
	LXI	B,BUFLEN	;NUMBER OF BYTES
	LDIR
	LXI	H,SUBFS2	;PT TO S2 OF $$$.SUB FCB
	MVI	M,0		;SET S2 TO ZERO
	INX	H		;PT TO RECORD COUNT
	DCR	M		;DECREMENT RECORD COUNT OF $$$.SUB
	LXI	D,SUBFCB	;CLOSE $$$.SUB
	CALL	CLOSE
	JRZ	RB1		;ABORT $$$.SUB IF ERROR
	MVI	A,SPRMPT	;PRINT SUBMIT PROMPT
	CALL	CONOUT
	LXI	H,CMDLIN	;PRINT COMMAND LINE FROM $$$.SUB
	CALL	PRIN1
	CALL	BREAK		;CHECK FOR ABORT (ANY CHAR)
	RNZ			;IF NO ^C, RETURN TO CALLER AND RUN
	CALL	SUBKIL		;KILL $$$.SUB IF ABORT
	JMP	RESTRT		;RESTART CPR
;
; INPUT COMMAND LINE FROM USER CONSOLE
;
RB1:
	CALL	SUBKIL		;ERASE $$$.SUB IF PRESENT
;
	ENDIF		;SUBON
;
	MVI	A,CPRMPT	;PRINT PROMPT
	CALL	CONOUT
	MVI	C,0AH		;READ COMMAND LINE FROM USER
	LXI	D,BUFSIZ
	CALL	BDOS
;
; STORE ZERO AT END OF COMMAND LINE
;
	LXI	H,CHRCNT	;PT TO CHAR COUNT
	MOV	A,M		;GET CHAR COUNT
	INX	H		;PT TO FIRST CHAR OF COMMAND LINE
	CALL	ADDAH		;PT TO AFTER LAST CHAR OF COMMAND LINE
	MVI	M,0		;STORE ENDING ZERO
	RET
;
; CHECK FOR ANY CHAR FROM USER CONSOLE; RET W/ZERO SET IF NONE
;
BREAK:
	EXX			;SAVE REGS
	CALL	BIOS+6		;CONSOLE STATUS CHECK
	ORA	A		;SET FLAGS
	CNZ	BIOS+9		;GET INPUT CHAR WITH ^S PROCESSING
	CPI	'S'-'@'		;PAUSE IF ^S
	CZ	BIOS+9		;GET NEXT CHAR
	EXX			;RESTORE REGS
	CPI	'C'-'@'		;CHECK FOR ABORT
	RET

;
; CHECK TO SEE IF DE PTS TO DELIMITER; IF SO, RET W/ZERO FLAG SET
;
SDELM:
	LDAX	D
	ORA	A		;0=DELIMITER
	RZ
	CPI	' '+1		;DELIM IF <= <SP>
	JRC	ZERO
	CPI	'='		;'='=DELIMITER
	RZ
	CPI	5FH		;UNDERSCORE=DELIMITER
	RZ
	CPI	'.'		;'.'=DELIMITER
	RZ
	CPI	':'		;':'=DELIMITER
	RZ
	CPI	','		;','=DELIMITER
	RZ
	CPI	';'		;';'=DELIMITER
	RZ
	CPI	'<'		;'<'=DELIMITER
	RZ
	CPI	'>'		;'>'=DELIMITER
;
	IF	MULTCMD		;MULTIPLE COMMANDS ALLOWED?
;
	RZ
	CPI	CMDSEP		;COMMAND SEPARATOR
;
	ENDIF		;MULTCMD
;
	RET
ZERO:
	XRA	A	;SET ZERO FLAG
	RET

;
; ADVANCE INPUT PTR TO FIRST NON-BLANK AND FALL THROUGH TO SBLANK
;
ADVAN:
	LDED	NXTCHR	;PT TO NEXT CHAR
;
; SKIP STRING PTED TO BY DE (STRING ENDS IN 0 OR CMDSEP) UNTIL END OF STRING
;   OR NON-DELIM ENCOUNTERED (BEGINNING OF TOKEN)
;
SBLANK:
	LDAX	D	;GET CHAR
	ORA	A	;ZERO?
	RZ
;
	IF	MULTCMD	;MULTIPLE COMMANDS ALLOWED?
;
	CPI	CMDSEP	;COMMAND SEPARATOR?
	RZ
;
	ENDIF		;MULTCMD
;
	CALL	SDELM	;SKIP OVER DELIMITER
	RNZ
	INX	D	;ADVANCE TO NEXT CHAR
	JR	SBLANK
;
; ADD A TO HL (HL=HL+A)
;
ADDAH:
	ADD	L
	MOV	L,A
	RNC
	INR	H
	RET
;
; EXTRACT DECIMAL NUMBER FROM COMMAND LINE
;   RETURN WITH VALUE IN REG A; ALL REGISTERS MAY BE AFFECTED
;
NUMBER:
	CALL	SCANER		;PARSE NUMBER AND PLACE IN FCBFN
	LXI	H,FCBFN+10 	;PT TO END OF TOKEN FOR CONVERSION
	MVI	B,11		;11 CHARS MAX
;
; CHECK FOR SUFFIX FOR HEXADECIMAL NUMBER
;
NUMS:
	MOV	A,M		;GET CHARS FROM END, SEARCHING FOR SUFFIX
	DCX	H		;BACK UP
	CPI	' '		;SPACE?
	JRNZ	NUMS1		;CHECK FOR SUFFIX
	DJNZ	NUMS		;COUNT DOWN
	JR	NUM0		;BY DEFAULT, PROCESS
NUMS1:
	CPI	NUMBASE		;CHECK AGAINST BASE SWITCH FLAG
	JRZ	HNUM0
;
; PROCESS DECIMAL NUMBER
;
NUM0:
	LXI	H,FCBFN		;PT TO BEGINNING OF TOKEN
NUM0A:
	LXI	B,1100H		;C=ACCUMULATED VALUE, B=CHAR COUNT
				; (C=0, B=11)
NUM1:
	MOV	A,M		;GET CHAR
	CPI	' '		;DONE IF <SP>
	JRZ	NUM2
	CPI	':'		;DONE IF COLON
	JRZ	NUM2
	INX	H		;PT TO NEXT CHAR
	SUI	'0'		;CONVERT TO BINARY (ASCII 0-9 TO BINARY)
	CPI	10		;ERROR IF >= 10
	JRNC	NUMERR
	MOV	D,A		;DIGIT IN D
	MOV	A,C		;NEW VALUE = OLD VALUE * 10
	RLC			;*2
	JRC	NUMERR
	RLC			;*4
	JRC	NUMERR
	RLC			;*8
	JRC	NUMERR
	ADD	C		;*9
	JRC	NUMERR
	ADD	C		;*10
	JRC	NUMERR
	ADD	D		;NEW VALUE = OLD VALUE * 10 + DIGIT
	JRC	NUMERR		;CHECK FOR RANGE ERROR
	MOV	C,A		;SET NEW VALUE
	DJNZ	NUM1		;COUNT DOWN
;
; RETURN FROM NUMBER
;
NUM2:
	MOV	A,C		;GET ACCUMULATED VALUE
	RET
;
; NUMBER ERROR ROUTINE FOR SPACE CONSERVATION
;
NUMERR:
	JMP	ERROR		;USE ERROR ROUTINE - THIS IS RELATIVE PT
;
; EXTRACT HEXADECIMAL NUMBER FROM COMMAND LINE
;   RETURN WITH VALUE IN REG A; ALL REGISTERS MAY BE AFFECTED
;
HEXNUM:
	CALL	SCANER		;PARSE NUMBER AND PLACE IN FCBFN
HNUM0:
	LXI	H,FCBFN		;PT TO TOKEN FOR CONVERSION
	LXI	D,0		;DE=ACCUMULATED VALUE
	MVI	B,11		;B=CHAR COUNT
HNUM1:
	MOV	A,M		;GET CHAR
	CPI	' '		;DONE?
	JRZ	HNUM3		;RETURN IF SO
	CPI	NUMBASE		;DONE IF NUMBASE SUFFIX
	JRZ	HNUM3
	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:
	INX	H		;PT TO NEXT CHAR
	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
;
; RETURN FROM HEXNUM
;
HNUM3:
	XCHG			;RETURNED VALUE IN HL
	MOV	A,L		;LOW-ORDER BYTE IN A
	RET
;
; PT TO DIRECTORY ENTRY IN TBUFF WHOSE OFFSET IS SPECIFIED BY A AND C
;
DIRPTR:
	LXI	H,TBUFF 	;PT TO TEMP BUFFER
	ADD	C		;PT TO 1ST BYTE OF DIR ENTRY
	CALL	ADDAH		;PT TO DESIRED BYTE IN DIR ENTRY
	MOV	A,M		;GET DESIRED BYTE
	RET
;
; CHECK FOR SPECIFIED DRIVE AND LOG IT IN
;
SLOGIN:
	XRA	A		;A=0 FOR DEFAULT DISK
	STA	FCBDN		;SELECT DEFAULT DISK SINCE USER/DISK
				;  SPECIFICALLY SELECTED BY THIS ROUTINE
TEMPDR	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;2ND BYTE (IMMEDIATE ARG) IS TEMPDR
	ORA	A		;0=CURRENT DRIVE
	JRNZ	SLOG1
	LDA	CURDR		;LOG IN CURRENT DRIVE
	INR	A		;ADD 1 FOR NEXT DCR
SLOG1:
	DCR	A		;ADJUST FOR PROPER DISK NUMBER (A=0)
	CALL	LOGIN		;LOG IN NEW DRIVE
TEMPUSR	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;2ND BYTE IS USER TO BE SELECTED
	JMP	SETUSR		;LOG IN NEW USER

;
; CHECK FOR SPECIFIED DRIVE AND LOG IN DEFAULT DRIVE IF SPECIFIED<>DEFAULT
;
DLOGIN:
CURDR	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;PREP TO LOG IN CURRENT DRIVE
	CALL	LOGIN		;LOGIN CURRENT DRIVE
CURUSR	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;PREP TO LOG IN CURRENT USER NUMBER
	JMP	SETUSR		;LOG IN NEW USER

;
;  ROUTINE TO CHECK FOR A WHEEL BYTE AS NON-ZERO
;    IF WHEEL BYTE IS ZERO, THEN ABORT (POP STACK AND RETURN)
;
;
	IF	WHEEL		;WHEEL FACILITY?
;
WHLCHK:
	LDA	WHLADR		;GET WHEEL BYTE
	ORA	A		;ZERO?
	RNZ			;OK IF NOT
	JMP	ERROR		;PROCESS AS ERROR
;
	ENDIF		;WHEEL
;

;
; EXTRACT TOKEN FROM COMMAND LINE AND PLACE IT INTO FCBDN;
;   FORMAT FCBDN FCB IF TOKEN RESEMBLES FILE NAME AND TYPE (FILENAME.TYP);
;   ON INPUT, NXTCHR PTS TO CHAR AT WHICH TO START SCAN;
;   ON OUTPUT, NXTCHR PTS TO CHAR AT WHICH TO CONTINUE AND ZERO FLAG IS RESET
;     IF '?' IS IN TOKEN
;
; ENTRY POINTS:
;	SCANLOG - LOAD TOKEN INTO FIRST FCB AND LOG IN TEMP USER/DISK
;	SCANER - LOAD TOKEN INTO FIRST FCB
;	SCANX - LOAD TOKEN INTO FCB PTED TO BY HL
;
SCANLOG:
	CALL	SCANER		;DO SCAN
	PUSH	PSW		;SAVE FLAG
	CALL	SLOGIN		;LOG IN TEMPORARY USER/DISK
	POP	PSW		;GET FLAG
	RET
SCANER:
	LXI	H,FCBDN 	;POINT TO FCBDN
SCANX:
	XRA	A		;A=0
	STA	TEMPDR		;SET TEMPORARY DRIVE NUMBER TO DEFAULT
	MOV	M,A		;SET FIRST BYTE OF FCBDN AS DEFAULT DRIVE
	STA	COLON		;SET NO COLON FLAG
	LDA	CURUSR		;GET CURRENT USER
	STA	TEMPUSR		;SET TEMPUSR
	CALL	ADVAN		;SKIP TO NON-BLANK OR END OF LINE
	SDED	CURTOK		;SET PTR TO NON-BLANK OR END OF LINE
	MVI	B,11		;PREP FOR POSSIBLE SPACE FILL
	JRZ	SCAN4		;DONE IF EOL
;
;  SCAN TOKEN FOR DU: FORM, WHICH MEANS WE HAVE A USER/DISK SPECIFICATION
;    DE PTS TO NEXT CHAR IN LINE, HL PTS TO FCBDN
;
	PUSH	D		;SAVE PTR TO FIRST CHAR
	CALL	SDELM		;CHECK FOR DELIMITER AND GET FIRST CHAR
	CPI	'A'		;IN LETTER RANGE?
	JRC	SCAN1
	CPI	'P'+1		;IN LETTER RANGE?
	JRC	SCAN1A
SCAN1:
	CPI	'0'		;CHECK FOR DIGIT RANGE
	JRC	SCAN2
	CPI	'9'+1		;IN DIGIT RANGE?
	JRNC	SCAN2
SCAN1A:
	INX	D		;PT TO NEXT CHAR
	CALL	SDELM		;CHECK FOR DELIMITER; IF NOT, CHECK FOR DIGIT
	JR	SCAN1
SCAN2:
	POP	D		;RESTORE PTR TO FIRST CHAR
	CPI	':'		;WAS DELIMITER A COLON?
	JRNZ	SCAN3		;DONE IF NO COLON
	STA	COLON		;SET COLON FOUND
;
;  SCAN FOR AND EXTRACT USER/DISK INFO
;    ON ENTRY, HL PTS TO FCBDN, DE PTS TO FIRST CHAR, AND A CONTAINS FIRST CHAR
;
	LDAX	D		;GET FIRST CHAR
	CPI	'A'		;CONVERT POSSIBLE DRIVE SPEC TO NUMBER
	JRC	SUD1		;IF LESS THAN 'A', MUST BE DIGIT
;
;  SET DISK NUMBER (A=1)
;
	SUI	'A'-1		;CONVERT DRIVE NUMBER TO 1-16
	CPI	MAXDISK+1	;WITHIN RANGE?
	JNC	ERROR		;INVALID DISK NUMBER
	STA	TEMPDR		;SET TEMPORARY DRIVE NUMBER
	MOV	M,A		;SET FCBDN
	INX	D		;PT TO NEXT CHAR
	LDAX	D		;SEE IF IT IS A COLON (:)
	CPI	':'
	JRZ	SUD2		;DONE IF NO USER NUMBER (IT IS A COLON)
;
;  SET USER NUMBER
;
SUD1:
	PUSH	H		;SAVE PTR TO FCBDN
	XCHG			;HL PTS TO FIRST DIGIT
	CALL	NUM0A		;GET NUMBER
	XCHG			;DE PTS TO TERMINATING COLON
	POP	H		;GET PTR TO FCBDN
	CPI	MAXUSR+1	;WITHIN LIMIT?
	JNC	ERROR
;
	IF	USERON		;ALLOW USER CHANGE ONLY IF USER IS ALLOWED
;
	STA	TEMPUSR		;SAVE USER NUMBER
;
	ENDIF
;
SUD2:
	INX	D		;PT TO CHAR AFTER COLON
;
; EXTRACT FILENAME FROM POSSIBLE FILENAME.TYP
;   DE PTS TO NEXT CHAR TO PROCESS, HL PTS TO FCBDN
;
SCAN3:
	XRA	A		;A=0
	STA	QMCNT		;INIT COUNT OF NUMBER OF QUESTION MARKS IN FCB
	MVI	B,8		;MAX OF 8 CHARS IN FILE NAME
	CALL	SCANF		;FILL FCB FILE NAME
;
; EXTRACT FILE TYPE FROM POSSIBLE FILENAME.TYP
;
	MVI	B,3		;PREPARE TO EXTRACT TYPE
	LDAX	D		;GET LAST CHAR WHICH STOPPED SCAN
	CPI	'.'		;IF (DE) DELIMITER IS A '.', WE HAVE A TYPE
	JRNZ	SCAN4		;FILL FILE TYPE BYTES WITH <SP>
	INX	D		;PT TO CHAR IN COMMAND LINE AFTER '.'
	CALL	SCANF		;FILL FCB FILE TYPE
	JR	SCAN5		;SKIP TO NEXT PROCESSING
SCAN4:
	CALL	SCANF4		;SPACE FILL
;
; FILL IN EX, S1, S2, AND RC WITH ZEROES
;
SCAN5:
	MVI	B,4		;4 BYTES
	XRA	A		;A=0
	CALL	SCANF5		;FILL WITH ZEROES
;
; SCAN COMPLETE -- DE PTS TO DELIMITER BYTE AFTER TOKEN
;
	SDED	NXTCHR
;
; SET ZERO FLAG TO INDICATE PRESENCE OF '?' IN FILENAME.TYP
;
QMCNT	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;NUMBER OF QUESTION MARKS
	ORA	A		;SET ZERO FLAG TO INDICATE ANY '?'
	RET

;
;  SCANF -- SCAN TOKEN PTED TO BY DE FOR A MAX OF B BYTES; PLACE IT INTO
;    FILE NAME FIELD PTED TO BY HL; EXPAND AND INTERPRET WILD CARDS OF
;    '*' AND '?'; ON EXIT, DE PTS TO TERMINATING DELIMITER
;
SCANF:
	CALL	SDELM		;DONE IF DELIMITER ENCOUNTERED - <SP> FILL
	JRZ	SCANF4
	INX	H		;PT TO NEXT BYTE IN FCBDN
	CPI	'*'		;IS (DE) A WILD CARD?
	JRNZ	SCANF1		;CONTINUE IF NOT
	MVI	M,'?'		;PLACE '?' IN FCB AND DON'T ADVANCE DE IF SO
	CALL	SCQ		;SCANNER COUNT QUESTION MARKS
	JR	SCANF2
SCANF1:
	MOV	M,A		;STORE FILENAME CHAR IN FCB
	INX	D		;PT TO NEXT CHAR IN COMMAND LINE
	CPI	'?'		;CHECK FOR QUESTION MARK (WILD)
	CZ	SCQ		;SCANNER COUNT QUESTION MARKS
SCANF2:
	DJNZ	SCANF		;DECREMENT CHAR COUNT UNTIL 8 ELAPSED
SCANF3:
	CALL	SDELM		;8 CHARS OR MORE - SKIP UNTIL DELIMITER
	RZ			;ZERO FLAG SET IF DELIMITER FOUND
	INX	D		;PT TO NEXT CHAR IN COMMAND LINE
	JR	SCANF3
;
;  FILL MEMORY POINTED TO BY HL WITH SPACES FOR B BYTES
;
SCANF4:
	MVI	A,' '		;<SP> FILL
SCANF5:
	INX	H		;PT TO NEXT BYTE IN FCB
	MOV	M,A		;FILL WITH BYTE IN A
	DJNZ	SCANF5
	RET
;
;  INCREMENT QUESTION MARK COUNT FOR SCANNER
;    THIS ROUTINE INCREMENTS THE COUNT OF THE NUMBER OF QUESTION MARKS IN
;    THE CURRENT FCB ENTRY
;
SCQ:
	PUSH	H		;SAVE HL
	LXI	H,QMCNT		;GET COUNT
	INR	M		;INCREMENT
	POP	H		;GET HL
	RET
;
; CMDTBL (COMMAND TABLE) SCANNER
;   ON RETURN, HL PTS TO ADDRESS OF COMMAND IF CPR-RESIDENT
;   ON RETURN, ZERO FLAG SET MEANS CPR-RESIDENT COMMAND
;
CMDSER:
	LXI	H,CMDTBL	;PT TO COMMAND TABLE
	MVI	C,NCMNDS	;SET COMMAND COUNTER
	MOV	A,C		;CHECK NUMBER OF COMMANDS
	ORA	A		;IF NONE, THEN ABORT
	JRZ	CMS5
CMS1:
	LXI	D,FCBFN 	;PT TO STORED COMMAND NAME
	MVI	B,NCHARS	;NUMBER OF CHARS/COMMAND (8 MAX)
CMS2:
	LDAX	D		;COMPARE AGAINST TABLE ENTRY
	CMP	M
	JRNZ	CMS3		;NO MATCH
	INX	D		;PT TO NEXT CHAR
	INX	H
	DJNZ	CMS2		;COUNT DOWN
	LDAX	D		;NEXT CHAR IN INPUT COMMAND MUST BE <SP>
	CPI	' '
	JRNZ	CMS4
	RET			;COMMAND IS CPR-RESIDENT (ZERO FLAG SET)
CMS3:
	INX	H		;SKIP TO NEXT COMMAND TABLE ENTRY
	DJNZ	CMS3
CMS4:
	INX	H		;SKIP ADDRESS
	INX	H
	DCR	C		;DECREMENT TABLE ENTRY NUMBER
	JRNZ	CMS1
CMS5:
	INR	C		;CLEAR ZERO FLAG
	RET			;COMMAND IS DISK-RESIDENT (ZERO FLAG CLEAR)
;
;**** Section 5 ****
; CPR-Resident Commands
;
;
;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 ENABLED
;
DIR:
	CALL	SCANLOG		;EXTRACT POSSIBLE D:FILENAME.TYP TOKEN AND LOG
	LXI	H,FCBFN 	;MAKE FCB WILD (ALL '?') IF NO FILENAME.TYP
	MOV	A,M		;GET FIRST CHAR OF FILENAME.TYP
	CPI	' '		;IF <SP>, ALL WILD
	CZ	FILLQ
	CALL	ADVAN		;LOOK AT NEXT INPUT CHAR
	MVI	B,80H		;PREPARE FOR DIR-ONLY SELECTION
	JRZ	DIRDN		;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	GOTFLG		;GOT SYSTEM SPECIFIER
	CPI	SOFLG		;SYS ONLY?
	JRNZ	DIRDN
	DCR	B		;B=0 FOR SYS FILES ONLY
GOTFLG:
	INX	D		;PT TO CHAR AFTER FLAG
DIRDN:
	SDED	NXTCHR		;SET PTR FOR NEXT PASS
				;DROP INTO DIRPR TO PRINT DIRECTORY
				; THEN RESTART CPR
;
	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
;
DIRPR:
	MOV	A,B		;GET FLAG
	STA	SYSTST		;SET SYSTEM TEST FLAG
	MVI	E,0		;SET COLUMN COUNTER TO ZERO
	PUSH	D		;SAVE COLUMN COUNTER (E)
	CALL	SEARF		;SEARCH FOR SPECIFIED FILE (FIRST OCCURRANCE)
	JRNZ	DIR3
	CALL	PRNNF		;PRINT NO FILE MSG; REG A NOT CHANGED
	XRA	A		;SET ZERO FLAG
	POP	D		;RESTORE DE
	RET
;
; ENTRY SELECTION LOOP; ON ENTRY, A=OFFSET FROM SEARF OR SEARN
;
DIR3:
	CALL	GETSBIT		;GET AND TEST FOR TYPE OF FILES
	JRZ	DIR6
	POP	D		;GET ENTRY COUNT (=<CR> COUNTER)
	MOV	A,E		;ADD 1 TO IT
	INR	E
	PUSH	D		;SAVE IT
	ANI	03H		;OUTPUT <CRLF> IF 4 ENTRIES PRINTED IN LINE
	JRNZ	DIR4
	CALL	CRLF		;NEW LINE
	JR	DIR5
DIR4:
	CALL	PRINT
;
	IF	WIDE
;
	DB	'  '		;2 SPACES
	DB	FENCE		;THEN FENCE CHAR
	DB	' ',' '+80H	;THEN 2 MORE SPACES
;
	ELSE
;
	DB	' '		;SPACE
	DB	FENCE		;THEN FENCE CHAR
	DB	' '+80H		;THEN SPACE
;
	ENDIF			;WIDE
;
DIR5:
	MVI	B,01H		;PT TO 1ST BYTE OF FILE NAME
	MOV	A,B		;A=OFFSET
	CALL	DIRPTR		;HL NOW PTS TO 1ST BYTE OF FILE NAME
	CALL	PRFN		;PRINT FILE NAME
DIR6:
	CALL	BREAK		;CHECK FOR ABORT
	JRZ	DIR7
	CALL	SEARN		;SEARCH FOR NEXT FILE
	JRNZ	DIR3		;CONTINUE IF FILE FOUND
DIR7:
	POP	D		;RESTORE STACK
	MVI	A,0FFH		;SET NZ FLAG
	ORA	A
	RET
;
	ENDIF			;DIRON OR ERAON
;
;  PRINT FILE NAME PTED TO BY HL
;
PRFN:
	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
	DCR	B	; COUNT DOWN
	JRNZ	PRFN1
	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)
	MVI	A,10		;ADD 10 TO PT TO SYSTEM FILE ATTRIBUTE BIT
	CALL	DIRPTR		;A=SYSTEM BYTE
	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
FQLP:
	MVI	M,'?'		;STORE '?'
	INX	H
	DJNZ	FQLP
	RET
;
;Section 5B
;Command: ERA
;Function:  Erase files
;Forms:
;	ERA <afn>	Erase Specified files and print their names
;	ERA <afn> V	Erase Specified files and print their names, but ask
;				for verification before Erase is done
;Notes:
;	Several Key Flags affect this command:
;		ERAV - If TRUE, the V option is enabled, and the character
;			which turns it on (the V) is defined by ERDFLG
;		ERAOK - If TRUE, the OK? prompt is enabled
;	If ERAOK is FALSE, the verification feature is disabled regardless
;		of what value ERAV has
;	If ERAOK is TRUE, then:
;		If ERAV is TRUE, verification is requested only if the V
;			flag (actual letter defined by ERDFLG) is in the
;			command line
;		If ERAV is FALSE, verification is always requested, and a
;			V flag in the command line will cause an error
;			message to be printed (V?) after the ERA is completed
;
	IF	ERAON		;ERA ENABLED?
;
ERA:
;
	IF	WERA		;WHEEL FACILITY ENABLED?
;
	CALL	WHLCHK		;CHECK FOR IT
;
	ENDIF		;WERA
;
	CALL	SCANLOG		;PARSE FILE SPECIFICATION AND LOG IN USER/DISK
;
	IF	ERAV AND ERAOK	;V FLAG AND OK? ENABLED?
;
	CALL	ADVAN		;GET ERAFLG IF IT'S THERE
	STA	ERAFLG		;SAVE IT AS A FLAG
	JRZ	ERA1		;JUMP IF INPUT ENDED
	INX	D		;PUT NEW BUF POINTER
ERA1:
	XCHG			;PUT PTR IN HL
	SHLD	NXTCHR		;SET PTR TO BYTE FOR NEXT COMMAND PROCESSING
;
	ENDIF			;ERAV
;
	MVI	B,1		;DISPLAY ALL MATCHING FILES
	CALL	DIRPR		;PRINT DIRECTORY OF ERASED FILES
	RZ			;ABORT IF NO FILES
;
	IF	ERAOK		;PRINT PROMPT
;
	IF	ERAV		;TEST VERIFY FLAG
;
ERAFLG	EQU	$+1		;ADDRESS OF FLAG
	MVI	A,0		;2ND BYTE IS FLAG
	CPI	ERDFLG		;IS IT A VERIFY OPTION?
	JRNZ	ERA2		;SKIP PROMPT IF IT IS NOT
;
	ENDIF			;ERAV
;
	CALL	PRINTC
	DB	'OK to Erase','?'+80H
	CALL	CONIN		;GET REPLY
	CPI	'Y'		;YES?
	RNZ			;ABORT IF NOT
;
	ENDIF			;ERAOK
;
ERA2:
	LXI	D,FCBDN 	;DELETE FILE SPECIFIED
	CALL	DELETE
	RET			;REENTER CPR
;
	ENDIF			;ERAON
;
;Section 5C
;Command: LIST
;Function:  Print out specified file on the LST: Device
;Forms:
;	LIST <ufn>	Print file (NO Paging)
;Notes:
;	The flags which apply to TYPE do not take effect with LIST
;
	IF	LTON		;LIST AND TYPE ENABLED?
;
LIST:
	MVI	A,0FFH		;TURN ON PRINTER FLAG
	JR	TYPE0
;
;Section 5D
;Command: TYPE
;Function:  Print out specified file on the CON: Device
;Forms:
;	TYPE <ufn>	Print file
;	TYPE <ufn> 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:
	XRA	A		;TURN OFF PRINTER FLAG
;
; ENTRY POINT FOR CPR LIST FUNCTION (LIST)
;
TYPE0:
	STA	PRFLG		;SET FLAG
;
	IF	WLT	;WHEEL ON?
;
	CALL	WHLCHK		;CHECK WHEEL BYTE
;
	ENDIF		;WLT
;
	CALL	SCANLOG		;EXTRACT FILENAME.TYP TOKEN AND LOG USER/DISK
	JNZ	ERROR		;ERROR IF ANY QUESTION MARKS
	CALL	ADVAN		;GET PGDFLG IF IT'S THERE
	STA	PGFLG		;SAVE IT AS A FLAG
	JRZ	TYPE1		;JUMP IF INPUT ENDED
	INX	D		;PUT NEW BUF POINTER
TYPE1:
	SDED	NXTCHR		;SET PTR TO BYTE FOR NEXT COMMAND PROCESSING
	CALL	OPENF		;OPEN SELECTED FILE
	JZ	ERROR		;ABORT IF ERROR
	CALL	CRLF		;NEW LINE
	MVI	A,NLINES-1	;SET LINE COUNT
	STA	PAGCNT
	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
	CALL	READF
	POP	B
	POP	H
	JRNZ	TYPE7		;ERROR?
	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)?
	RZ			;RESTART CPR 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
	INR	B		;INCREMENT TAB COUNT
	JR	TYPE6
;
;  OUTPUT <CR> OR <LF> AND RESET TAB COUNT
;
TYPE4:
	CALL	LCOUT		;OUTPUT <CR> OR <LF>
	MVI	B,0		;RESET TAB COUNTER
	JR	TYPE6
;
;  TABULATE
;
TYPE5:
	MVI	A,' '		;<SP>
	CALL	LCOUT
	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
	RZ			;RESTART IF SO
	JR	TYPE2
TYPE7:
	DCR	A		;NO ERROR?
	RZ			;RESTART CPR
	JMP	ERROR
;
	ENDIF			;LTON
;
;Section 5E
;Command: SAVE
;Function:  To save the contents of the TPA onto disk as a file
;Forms:
;	SAVE <Number of Pages> <ufn>
;				Save specified number of pages (start at 100H)
;				from TPA into specified file; <Number of
;				Pages> is in DEC
;	SAVE <Number of Sectors> <ufn> S
;				Like SAVE above, but numeric argument specifies
;				number of sectors rather than pages
;Notes:
;	The MULTCMD flag (Multiple Commands Allowed) expands the code slightly,
;		but is required to support multiple commands with SAVE
;	The SECTFLG defines the letter which indicates a sector count
;		(S in the Forms section above)
;
	IF	SAVEON		;SAVE ENABLED?
;
SAVE:
;
	IF	WSAVE	;WHEEL FACILITY?
;
	CALL	WHLCHK		;CHECK FOR WHEEL BYTE
;
	ENDIF		;WSAVE
;
	CALL	NUMBER		;EXTRACT NUMBER FROM COMMAND LINE
	MOV	L,A		;HL=PAGE COUNT
	MVI	H,0
	PUSH	H		;SAVE PAGE COUNT
	CALL	EXTEST		;TEST FOR EXISTENCE OF FILE AND ABORT IF SO
	MVI	C,16H		;BDOS MAKE FILE
	CALL	GRBDOS
	POP	H		;GET PAGE COUNT
	JRZ	SAVE3		;ERROR?
	XRA	A		;SET RECORD COUNT FIELD OF NEW FILE'S FCB
	STA	FCBCR
	CALL	ADVAN		;LOOK FOR 'S' FOR SECTOR OPTION
	INX	D		;PT TO AFTER 'S' TOKEN
	CPI	SECTFLG
	JRZ	SAVE0
	DCX	D		;NO 'S' TOKEN, SO BACK UP
	DAD	H		;DOUBLE IT FOR HL=SECTOR (128 BYTES) COUNT
SAVE0:
	SDED	NXTCHR		;SET PTR TO BAD TOKEN OR AFTER GOOD TOKEN
	LXI	D,TPA		;PT TO START OF SAVE AREA (TPA)
SAVE1:
	MOV	A,H		;DONE WITH SAVE?
	ORA	L		;HL=0 IF SO
	JRZ	SAVE2
	DCX	H		;COUNT DOWN ON SECTORS
	PUSH	H		;SAVE PTR TO BLOCK TO SAVE
	LXI	H,128		;128 BYTES PER SECTOR
	DAD	D		;PT TO NEXT SECTOR
	PUSH	H		;SAVE ON STACK
	CALL	DMASET		;SET DMA ADDRESS FOR WRITE (ADDRESS IN DE)
	LXI	D,FCBDN 	;WRITE SECTOR
	MVI	C,15H		;BDOS WRITE SECTOR
	CALL	BDOSB		;SAVE BC
	POP	D		;GET PTR TO NEXT SECTOR IN DE
	POP	H		;GET SECTOR COUNT
	JRNZ	SAVE3		;WRITE ERROR?
	JR	SAVE1		;CONTINUE
SAVE2:
	LXI	D,FCBDN 	;CLOSE SAVED FILE
	CALL	CLOSE
	INR	A		;ERROR?
	JRNZ	SAVE4
SAVE3:
	CALL	PRNLE		;PRINT 'NO SPACE' ERROR
SAVE4:
	JMP	DEFDMA		;SET DMA TO 0080 AND RESTART CPR
;
	ENDIF			;SAVEON
;
; Test File in FCB for existence, ask user to delete if so, and abort if he
;  choses not to
;
	IF	SAVEON OR RENON	;FOR SAVE AND REN FUNCTIONS
;
EXTEST:
	CALL	SCANLOG		;EXTRACT FILE NAME AND LOG IN USER/DISK
	JNZ	ERROR		;'?' IS NOT PERMITTED
	CALL	SEARF		;LOOK FOR SPECIFIED FILE
	LXI	D,FCBDN		;PT TO FILE FCB
	RZ			;OK IF NOT FOUND
	PUSH	D		;SAVE PTR TO FCB
	CALL	PRINTC
	DB	'Erase',' '+80H
	LXI	H,FCBFN		;PT TO FILE NAME FIELD
	CALL	PRFN		;PRINT IT
	MVI	A,'?'		;PRINT QUESTION
	CALL	CONOUT
	CALL	CONIN		;GET RESPONSE
	POP	D		;GET PTR TO FCB
	CPI	'Y'		;KEY ON YES
	JNZ	ERR3		;RESTART AS ERROR IF NO
	PUSH	D		;SAVE PTR TO FCB
	CALL	DELETE		;DELETE FILE
	POP	D		;GET PTR TO FCB
	RET
;
	ENDIF			;SAVEON OR RENON
;
;Section 5F
;Command: REN
;Function:  To change the name of an existing file
;Forms:
;	REN <New ufn>=<Old ufn>	Perform function
;
	IF	RENON		;REN ENABLED?
;
REN:
;
	IF	WREN		;WHEEL FACILITY?
;
	CALL	WHLCHK		;CHECK FOR WHEEL BYTE
;
	ENDIF		;WREN
;
	CALL	EXTEST		;TEST FOR FILE EXISTENCE AND RETURN
				; IF FILE DOESN'T EXIST; ABORT IF IT DOES
	LDA	TEMPDR		;SAVE SELECTED DISK
	PUSH	PSW		;SAVE ON STACK
REN0:
	LXI	H,FCBDN 	;SAVE NEW FILE NAME
	LXI	D,FCBDM
	LXI	B,16		;16 BYTES
	LDIR
	CALL	ADVAN		;ADVANCE TO NEXT CHARACTER (NON-DELIM)
	JRZ	REN4		;ERROR IF NONE
;
;  PERFORM RENAME FUNCTION
;
REN1:
	SDED	NXTCHR		;SAVE PTR TO OLD FILE NAME
	CALL	SCANER		;EXTRACT FILENAME.TYP TOKEN
	JRNZ	REN4		;ERROR IF ANY '?'
	POP	PSW		;GET OLD DEFAULT DRIVE
	MOV	B,A		;SAVE IT
	LXI	H,TEMPDR	;COMPARE IT AGAINST SELECTED DRIVE
	MOV	A,M		;DEFAULT?
	ORA	A
	JRZ	REN2
	CMP	B		;CHECK FOR DRIVE ERROR (LIKE REN A:T=B:S)
	JRNZ	REN4
REN2:
	MOV	M,B
	XRA	A
	STA	FCBDN		;SET DEFAULT DRIVE
	LXI	D,FCBDN 	;RENAME FILE
	MVI	C,17H		;BDOS RENAME FCT
	CALL	GRBDOS
	RNZ
REN3:
	CALL	PRNNF		;PRINT NO FILE MSG
REN4:
	JMP	ERROR
;
	ENDIF			;RENON
;
RSTJMP:
	JMP	RCPRNL		;RESTART CPR
;
;Section 5G
;Command: JUMP
;Function:  To Call the program (subroutine) at the specified address
;	     without loading from disk
;Forms:
;	JUMP <adr>		Call at <adr>;<adr> is in HEX
;
	IF	JUMPON		;JUMP ENABLED?
;
JUMP:
;
	IF	WJUMP	;WHEEL FACILITY?
;
	CALL	WHLCHK		;CHECK FOR WHEEL BYTE
;
	ENDIF		;WJUMP
;
	CALL	HEXNUM		;GET LOAD ADDRESS IN HL
	JR	CALLPROG	;PERFORM CALL
;
	ENDIF			;JUMPON
;
;Section 5H
;Command: GO
;Function:  To Call the program in the TPA without loading
;	     loading from disk. Same as JUMP 100H, but much
;	     more convenient, especially when used with
;	     parameters for programs like STAT. Also can be
;	     allowed on remote-access systems with no problems.
;
;Form:
;	GO <parameters like for COMMAND>
;
	IF	GOON		;GO ENABLED?
;
GO:
;
	IF	WGO	;WHEEL FACILITY?
;
	CALL	WHLCHK		;CHECK FOR WHEEL BYTE
;
	ENDIF		;WGO
;
	LXI	H,TPA		;Always to TPA
	JR	CALLPROG	;Perform call
;
	ENDIF			;GOON
;
;Section 5I
;Command: COM file processing
;Function:  To load the specified COM file from disk and execute it
;Forms:  <command line>
;Notes:
;	COM files are processed as follows --
;		1. File name buffers are initialized and a preliminary
;			error check is done
;		2. MLOAD is used to search for the file along the Path
;			and load it into the TPA
;		3. CALLPROG is used to set up the buffers to be used by
;			the transient (FCB at 5CH, FCB at 6CH, BUFF at 80H)
;			and run the program
;	The flag MULTCMD comes into play frequently here; it mainly serves
;		to save space if MULTCMD is FALSE and enables Multiple
;		Commands on the same line if MULTCMD is TRUE
;
COM:
	LDA	FCBFN		;ANY COMMAND?
	CPI	' '		;' ' MEANS COMMAND WAS 'D:' TO SWITCH
	JRNZ	COM1		;NOT <SP>, SO MUST BE TRANSIENT OR ERROR
;
;  ENTRY POINT TO SELECT USER/DISK
;
;
	IF	WDU	;WHEEL FACILITY?
;
	CALL	WHLCHK		;CHECK FOR WHEEL BYTE
;
	ENDIF		;WDU
;
	LDA	COLON		;LOOK FOR COLON FLAG
	ORA	A		;IF ZERO, JUST BLANK
	RZ			;RETURN TO MAIN ROUTINE IF NOTHING SPECIFIED
;
;  COMMAND IS DU:, SO LOG IN USER/DISK
;
	LDA	TEMPUSR		;GET SELECTED USER
	CPI	10H		;MAKE SURE 4 BITS
	JNC	ERROR		;RANGE ERROR?
	STA	CURUSR		;SET CURRENT USER
	CALL	SLOGIN		;LOG IN USER/DISK AS IF TEMPORARILY
;
;  NOW, MAKE LOGIN PERMANENT
;
	LDA	TEMPDR		;GET SELECTED DRIVE
	ORA	A		;IF 0 (DEFAULT), NO CHANGE
	JRZ	COM0
	DCR	A		;ADJUST FOR LOG IN
	STA	CURDR		;SET CURRENT DRIVE
COM0:
	JMP	SETUD		;SET CURRENT USER/DISK AND RET THRU DLOGIN
;
;  PROCESS COMMAND
;
COM1:
	LXI	D,FCBFT		;PT TO FILE TYPE
	LDAX	D		;GET FIRST CHAR OF FILE TYPE
	CPI	' '		;MUST BE BLANK, OR ERROR
	JNZ	ERROR
	LXI	H,COMMSG	;PLACE DEFAULT FILE TYPE (COM) INTO FCB
	LXI	B,3		;3 BYTES
	LDIR
	LXI	H,TPA		;SET EXECUTION/LOAD ADDRESS
	PUSH	H		;SAVE FOR EXECUTION
;
	IF	CMDRUN		;COMMAND RUN FACILITY AVAILABLE?
;
	MVI	A,0FFH		;USE IT IF AVAILABLE
;
	ENDIF		;CMDRUN
;
	CALL	MLOAD		;LOAD MEMORY WITH FILE SPECIFIED IN CMD LINE
	POP	H		;GET EXECUTION ADDRESS
;
; CALLPROG IS THE ENTRY POINT FOR THE EXECUTION OF THE LOADED
;   PROGRAM; ON ENTRY TO THIS ROUTINE, HL MUST CONTAIN THE EXECUTION
;   ADDRESS OF THE PROGRAM (SUBROUTINE) TO EXECUTE
;
CALLPROG:
	SHLD	EXECADR		;PERFORM IN-LINE CODE MODIFICATION
	CALL	SCANER		;SEARCH COMMAND LINE FOR NEXT TOKEN
	LXI	H,TEMPDR	;SAVE PTR TO DRIVE SPEC
	PUSH	H
	MOV	A,M		;SET DRIVE SPEC
	STA	FCBDN
	LXI	H,FCBDN+10H	;PT TO 2ND FILE NAME
	CALL	SCANX		;SCAN FOR IT AND LOAD IT INTO FCB+16
	POP	H		;SET UP DRIVE SPECS
	MOV	A,M
	STA	FCBDM
	XRA	A
	STA	FCBCR
	LXI	D,TFCB		;COPY TO DEFAULT FCB
	LXI	H,FCBDN 	;FROM FCBDN
	LXI	B,33		;SET UP DEFAULT FCB
	LDIR
CMDCH1	EQU	$+1		;IN-THE-CODE BUFFER FOR ADDRESS OF 1ST CHAR
	LXI	H,CMDLIN
CALLP1:
	MOV	A,M		;SKIP TO END OF 2ND FILE NAME
	ORA	A		;END OF LINE?
	JRZ	CALLP2
;
	IF	MULTCMD		;MULTIPLE COMMANDS ALLOWED?
;
	CPI	CMDSEP		;COMMAND SEPARATOR?
	JRZ	CALLP2
;
	ENDIF		;MULTCMD
;
	CPI	' '		;END OF TOKEN?
	JRZ	CALLP2
	INX	H
	JR	CALLP1
;
; LOAD COMMAND LINE INTO TBUFF
;
CALLP2:
	MVI	B,0		;SET CHAR COUNT
	LXI	D,TBUFF+1	;PT TO CHAR POS
CALLP3:
	MOV	A,M		;COPY COMMAND LINE TO TBUFF
	STAX	D
	ORA	A		;DONE IF ZERO
	JRZ	CALLP5
;
	IF	MULTCMD		;MULTIPLE COMMANDS ALLOWED?
;
	CPI	CMDSEP		;DONE IF COMMAND SEPARATOR
	JRZ	CALLP4
;
	ENDIF		;MULTCMD
;
	INR	B		;INCR CHAR COUNT
	INX	H		;PT TO NEXT
	INX	D
	JR	CALLP3
;
	IF	MULTCMD		;MULTIPLE COMMANDS ALLOWED?
;
CALLP4:
	XRA	A		;STORE ENDING ZERO
	STAX	D		;INSTEAD OF CMDSEP
;
	ENDIF		;MULTCMD
;
; RUN LOADED TRANSIENT PROGRAM
;
CALLP5:
;
	IF	MULTCMD		;MULTIPLE COMMANDS ALLOWED?
;
	SHLD	NXTCHR		;SAVE PTR TO CONTINUE PROCESSING
;
	ENDIF		;MULTCMD
;
	MOV	A,B		;SAVE CHAR COUNT
	STA	TBUFF
	CALL	CRLF		;NEW LINE
	CALL	DEFDMA		;SET DMA TO 0080
;
; EXECUTION (CALL) OF PROGRAM (SUBROUTINE) OCCURS HERE
;
EXECADR	EQU	$+1		;CHANGE ADDRESS FOR IN-LINE CODE MODIFICATION
	CALL	TPA		;CALL TRANSIENT
	CALL	DEFDMA		;SET DMA TO 0080, IN CASE PROG CHANGED IT
	CALL	DLOGIN		;LOGIN CURRENT USER/DISK
	JMP	CONT		;RESTART CPR AND CONTINUE COMMAND PROCESSING
;
;Section 5J
;Command: GET
;Function:  To load the specified file from disk to the specified address
;Forms:
;	GET <adr> <ufn>	Load the specified file at the specified page;
;			<adr> is in HEX
;
	IF	GETON		;GET ENABLED?
;
GET:
;
	IF	WGET	;WHEEL ON?
;
	CALL	WHLCHK		;CHECK WHEEL BYTE
;
	ENDIF		;WGET
;
	CALL	HEXNUM		;GET LOAD ADDRESS IN HL
	PUSH	H		;SAVE ADDRESS
	CALL	SCANER		;GET FILE NAME
	POP	H		;RESTORE ADDRESS
	JNZ	ERROR		;MUST BE UNAMBIGUOUS
;
; FALL THRU TO MLOAD
;
	IF	CMDRUN		;COMMAND RUN FACILITY AVAILABLE?
;
	XRA	A		;NO CMDRUN IF FACILITY IS THERE
;
	ENDIF			;CMDRUN
;
	ENDIF			;GETON

;
;  MEMORY LOAD SUBROUTINE
;
; LOAD MEMORY WITH THE FILE WHOSE NAME IS SPECIFIED IN THE COMMAND LINE
;   ON INPUT, HL CONTAINS STARTING ADDRESS TO LOAD
;
;	EXIT POINTS ARE A RETURN AND LOG IN CURRENT USER/DISK IF NO ERROR,
; A JMP TO ERROR IF COM FILE NOT FOUND OR A MESSAGE AND ABORT IF MEMORY FULL
;
MLOAD:
;
	IF	CMDRUN	;CMDRUN FACILITY?
;
	STA	CRFLAG	;SAVE FLAG
;
	ENDIF		;CMDRUN
;
	SHLD	LOADADR		;SET LOAD ADDRESS
;
;   MLA is a reentry point for a non-standard CP/M Modification
; The PATH command-search is implemented by this routine
;
MLA:
;
	IF	DRVPREFIX	;IF DRIVE PREFIX ALLOWED ...
;
	MVI	A,DRVPFATT	;SET FLAG PER USER SPEC FOR SYS/NON-SYS
	STA	SYSTST		;TEST FLAG IN GETSBIT
	CALL	SLOGIN		;LOOK UNDER TEMPORARY USER/DISK
	CALL	SEARF		;LOOK FOR FILE
MLARUN:
	LXI	H,PATH		;PT TO PATH FOR FAILURE POSSIBILITY
	JRNZ	MLA4		;FOUND IT -- LOAD IT AND RUN
;
	ELSE			;NO DRIVE PREFIX
;
MLARUN:
	LXI	H,PATH		;POINT TO PATH
;
	ENDIF		;DRVPREFIX
;
MLA0:
	MOV	A,M		;GET DRIVE
	ORA	A		;0=DONE=COMMAND NOT FOUND
;
	IF	CMDRUN		;COMMAND RUN FACILITY
;
	JRNZ	NOCRUN		;NOT READY FOR CMD RUN YET
CRFLAG	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;CHECK CRFLAG
	ORA	A		;0=NO
	JZ	ERROR		;PROCESS AS ERROR IF CMD RUN EXHAUSTED
;
	IF	ROOTONLY	;ONLY LOOK FOR EXT COMMAND PROCESSOR AT ROOT
;
	PUSH	H
;
	ENDIF		;ROOTONLY
;
	XRA	A		;DO NOT REENTER THIS CODE
	STA	CRFLAG		;SET ZERO FOR NO ENTRY
	LHLD	CMDCH1		;GET PTR TO FIRST CHAR OF COMMAND
	DCX	H		;PT TO CHAR COUNT
	MVI	M,' '		;STORE LEADING SPACE
	SHLD	CMDCH1		;POINT TO LEADING SPACE AS FIRST CHAR
	SHLD	NXTCHR		;NEXT CHAR IS FIRST CHAR OF COMMAND
	LXI	H,CFCB		;SET CFCB AS COMMAND
	LXI	D,FCBDN		;... BY COPYING IT INTO FCBDN
	LXI	B,12		;ONLY 12 BYTES REQUIRED
	LDIR
;
	IF	ROOTONLY	;LOOK FOR EXT COMMAND PROCESSOR AT ROOT ONLY?
;
	JR	MLA3RT
;
	ELSE			;FOLLOW PATH LOOKING FOR EXT COMMAND PROCESSOR
;
	XRA	A		;A=0
	JR	MLARUN		;NOW TRY THE RUN
;
	ENDIF		;ROOTONLY
;
CFCB:
	CMDFCB			;FCB DEFINING INITIAL COMMAND
NOCRUN:
;
	ELSE
;
	JZ	ERROR		;TRANSIENT LOAD ERROR -- FILE NOT FOUND
;
	ENDIF		;CMDRUN
;
; LOOK FOR COMMAND IN DIRECTORY PTED TO BY HL; DRIVE IN A
;
	CPI	CURIND		;CURRENT DRIVE SPECIFIED?
	JRNZ	MLA1		;SKIP DEFAULT DRIVE SELECTION IF SO
	LDA	CURDR		;GET CURRENT DRIVE
	INR	A		;SET A=1
MLA1:
	STA	TEMPDR		;SELECT DIFFERENT DRIVE IF NOT CURRENT
	MVI	A,1		;PREPARE TO ACCEPT BOTH SYSTEM AND DIR FILES
	STA	SYSTST		;TEST FLAG IS 1 FOR BOTH
	INX	H		;PT TO USER NUMBER
	MOV	A,M		;GET USER NUMBER
	INX	H		;PT TO NEXT ENTRY IN PATH
	PUSH	H		;SAVE PTR
	ANI	7FH		;MASK OUT SYSTEM BIT
	CPI	CURIND		;CURRENT USER SPECIFIED?
	JRNZ	MLA2		;DO NOT SELECT CURRENT USER IF SO
	LDA	CURUSR		;GET CURRENT USER NUMBER
MLA2:
	STA	TEMPUSR		;SET TEMPORARY USER NUMBER
	CMA			;FLIP BITS SO SYSTEM BIT IS 0 IF SYS-ONLY
	ANI	80H		;MASK FOR ONLY NOT OF SYSTEM BIT TO SHOW
	JRNZ	MLA3		;DON'T SET FLAG IS ORIGINALLY SYSTEM BIT=0
	STA	SYSTST		;TEST FLAG IS 0 FOR SYS-ONLY, 1 FOR BOTH
MLA3:
	CALL	SLOGIN		;LOG IN PATH-SPECIFIED USER/DISK
MLA3RT:
	CALL	SEARF		;LOOK FOR FILE
	POP	H		;GET PTR TO NEXT PATH ENTRY
	JRZ	MLA0		;CONTINUE PATH SEARCH IF SEARCH FAILED
				;LOAD IF SEARCH SUCCEEDED
;
; FILE FOUND -- PERFORM SYSTEM TEST AND PROCEED IF APPROVED
;
MLA4:
	PUSH	H		;SAVE PTR
	CALL	GETSBIT		;CHECK SYSTEM BIT
	POP	H		;GET PTR
	JRZ	MLA0		;CONTINUE IF NO MATCH
	CALL	OPENF		;OPEN FILE FOR INPUT
LOADADR	EQU	$+1		;MEMORY LOAD ADDRESS (IN-LINE CODE MOD)
	LXI	H,TPA		;SET START ADDRESS OF MEMORY LOAD
MLA5:
	MVI	A,ENTRY/256-1	;GET HIGH-ORDER ADR OF JUST BELOW CPR
	CMP	H		;ARE WE GOING TO OVERWRITE THE CPR?
	JRC	PRNLE		;ERROR IF SO
	PUSH	H		;SAVE ADDRESS OF NEXT SECTOR
	XCHG			;... IN DE
	CALL	DMASET		;SET DMA ADDRESS FOR LOAD
	LXI	D,FCBDN 	;READ NEXT SECTOR
	CALL	READ
	POP	H		;GET ADDRESS OF NEXT SECTOR
	JRNZ	MLA6		;READ ERROR OR EOF?
	LXI	D,128		;MOVE 128 BYTES PER SECTOR
	DAD	D		;PT TO NEXT SECTOR IN HL
	JR	MLA5
;
MLA6:
	DCR	A		;LOAD COMPLETE
	JZ	DLOGIN		;OK IF ZERO, ELSE FALL THRU TO PRNLE

;
; LOAD ERROR
;
PRNLE:
	CALL	PRINTC
	DB	'Ful','l'+80H
	CALL	DLOGIN		;RESTORE CURRENT USER/DISK
	JMP	RESTRT		;RESTART ZCPR

;*****

;
;  DEFAULT PATH USED FOR PATH COMMAND-SEARCH
;
	IF	INTPATH		;USE THIS PATH?
;
PATH:
	IPATH			;PATH DEFINED IN ZCPRHDR.LIB
;
	ENDIF		;INTPATH

;*****
	IF	INTSTACK	;INTERNAL STACK
;
;  STACK AREA
;
	DS	48		;STACK AREA
STACK	EQU	$		;TOP OF STACK
;
	ENDIF		;INTSTACK
;

;
;	The following will cause an error message to appear if
; the size of ZCPR2 is over 2K bytes.
;
	IF	($ GT CPRLOC+800H)
ZCPR2ER	EQU	NOVALUE		;ZCPR2 IS LARGER THAN 2K BYTES
	ENDIF

	END