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

*************************************************************************
*									*
*  Z C P R 3 -- Z80-Based Command Processor Replacement, Version 3.0	*
*									*
*  Copyright (c) 1984 by Richard Conn					*
*  Copyright US Government						*
*  All Rights Reserved							*
*									*
*  ZCPR3 was written by Richard Conn, who assumes no responsibility	*
*  or liability for its use.  ZCPR3 is released to the CP/M user	*
*  community for non-commercial use only.				*
*									*
*  All registered users of CP/M are encouraged to freely copy and use	*
*  ZCPR3 and its associated utilities on their registered systems for	*
*  non-commercial purposes.						*
*									*
*  Any commercial use of ZCPR3 is prohibited unless approved by the	*
*  author, Richard Conn, or his authorized agent, Echelon, Inc, in	*
*  writing.								*
*									*
*  This is the RELEASE VERSION of ZCPR3.  Dated: 21 Apr 84		*
*									*
*************************************************************************

;
;  ZCPR3 -- CP/M Z80 Command Processor Replacement (ZCPR) Version 3.0
;
;	ZCPR3 is based upon ZCPR2
;
;******** Structure Notes ********
;
;	ZCPR3 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 ZCPR3
;			ENTRY
;
;    1		Buffers
;			1. Input Command Line and Default Command
;			2. File Type of COM File
;			3. SUBMIT File Control Block
;			4. Command File Control Block
;			5. Line Count Buffer
;			6. Resident Command Table
;
;    2		CPR Starting Modules
;			CPR1	CPR	RESTRT	RS0	RS1
;			RS2	PARSER	SCANNER	DUSCAN	DIRSCAN
;			PASSCK	SKSP	TSTEOL	INITFCB	IFCB
;			FILL	PRNNF
;
;    3		Utilities
;			CONIN	CRLF	CONOUT	LCOUT	LSTOUT
;			PAGER	READF	READ	BDOSB	NOTE
;			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	PROMPT	READBUF	BREAK
;			SDELM	ADDAH	LDIR	NUMBER	NUMERR
;			HEXNUM	FCBLOG	SLOGIN	WHLCHK	CMDSER
;
;     5		CPR-Resident Commands and Functions
;     5A		DIR	DIRPR	PRFN	DIRPTR	GETSBIT
;     5B		ERA
;     5C		LIST
;     5D		TYPE
;     5E		SAVE	AMBCHK	EXTEST
;     5F		REN
;     5G		JUMP
;     5H		GO
;     5I		COMDIR	COM	CALLPROG
;     5J		GET	MLOAD	DLOGIN	PRNLE	PATH
;			MPATH	STACK	PWLIN
;

;
;	The following MACLIB statements load all the user-selected equates
; which are used to customize ZCPR3 for the user's working environment.
;
	MACLIB	Z3BASE
	MACLIB	Z3HDR
;
CTRLC	EQU	03H
TAB	EQU	09H
LF	EQU	0AH
CR	EQU	0DH
;
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
TFCB2	EQU	TFCB+16			;2ND FCB
TBUFF	EQU	BASE+0080H		;DEFAULT DISK I/O BUFFER
TPA	EQU	BASE+0100H		;BASE OF TPA
BIOS	EQU	CCP+0800H+0E00H		;BIOS Location
;
$-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
;	PUTRG	- SAVE REGISTERS
;	GETRG	- RESTORE REGISTERS
;
;	@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
	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
;
PUTRG	MACRO
	PUSH	H	;;SAVE REGISTERS IN ORDER
	PUSH	D
	PUSH	B
	ENDM
;
GETRG	MACRO
	POP	B	;;RESTORE REGISTERS IN ORDER
	POP	D
	POP	H
	ENDM
;
; END OF Z80 MACRO EXTENSIONS
;
;
;**** Section 0 ****
;
	ORG	CPRLOC
;
;  ENTRY POINTS INTO ZCPR3
;
;  IF MULTCMD (MULTIPLE COMMANDS ON ONE LINE) is FALSE:
;	If ZCPR3 is entered at location CPRLOC (at the JMP to CPR), then
; the default command in CMDLIN will be processed.  If ZCPR3 is entered
; at location CPRLOC+3 (at the JMP to CPR1), then the default command in
; CMDLIN will NOT be processed.
;	NOTE:  Entry into ZCPR3 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).
;
;  IF MULTCMD is TRUE:
;	Entry at CPR or CPR1 has the same effect.  Multiple command processing
; will still continue.
;
;	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.  Some ZCPR3 utilities, like ALIAS and MENU,
; require multiple commands, and this feature also permits simple chaining
; of programs to be possible under the ZCPR3 environment.
;
;	Enjoy using ZCPR3!
;			Richard Conn
;
ENTRY:
	JMP	CPR	; Process potential default command
	JMP	CPR1	; Do NOT process potential default command
;
;**** Section 1 ****
; BUFFERS ET AL
;
;  **** 1. INPUT COMMAND LINE AND DEFAULT COMMAND
;
	IF	MULTCMD		;MULTIPLE COMMANDS ALLOWED?
;
; For Multiple Commands, the command line buffer (CMDLIN) is located external
; to ZCPR3 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	Z3CL		;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)
BUFLEN	EQU	Z3CLS		;LENGTH OF BUFFER
;
	ELSE
;
; If no multiple commands are permitted, these buffers are left internal
; to ZCPR3 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
;

;
;  **** 2. FILE TYPE FOR COMMAND
;
COMMSG:
	COMTYP			;USE MACRO FROM Z3HDR.LIB
;
	IF	SUBON		;IF SUBMIT FACILITY ENABLED ...
;
;  **** 3. SUBMIT FILE CONTROL BLOCK
;
SUBFCB:
	DB	1		;DISK NAME SET TO DEFAULT TO DRIVE A:
	DB	'$$$'		;FILE NAME
	DB	'     '
	SUBTYP			;USE MACRO FROM Z3HDR.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
;
;  **** 4. COMMAND FILE CONTROL BLOCK
;
	IF	EXTFCB NE 0	;MAY BE PLACED EXTERNAL TO ZCPR3
;
FCBDN	EQU	EXTFCB		;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 ZCPR3
;
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
;

;
;  **** 5. LINE COUNT BUFFER
;
	IF	LTON
PAGCNT:
	DB	NLINES-2	;LINES LEFT ON PAGE
	ENDIF		;LTON
;
;  **** 6. RESIDENT COMMAND TABLE
;   EACH TABLE ENTRY IS STRUCTURED AS FOLLOWS:
;	DB	'NAME'	;NCHARS LONG
;	DW	ADDRESS	;ADDRESS OF COMMAND
;
CMDTBL:
	DB	NCHARS	;SIZE OF TEXT IN COMMAND TABLE
	CTABLE		;DEFINE COMMAND TABLE VIA MACRO IN Z3HDR FILE
	DB	0	;END OF TABLE
;

;
;**** Section 2 ****
; ZCPR3 STARTING POINTS
;
; START ZCPR3 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 ZCPR3 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
;
	JR	RS1		;CHECK COMMAND LINE FOR CONTENT
;
; PROMPT USER AND INPUT COMMAND LINE FROM HIM
;
RESTRT:
	LXI	SP,STACK	;RESET STACK
;
; READ INPUT LINE FROM USER OR $$$.SUB
;
RS0:
;
	IF	Z3MSG NE 0
	XRA	A		;SET NO OUTPUT MESSAGE
	STA	Z3MSG+3		;ZCPR3 COMMAND STATUS
	INR	A		;SET ZCPR3 INPUT PROMPT
	STA	Z3MSG+7		;ZEX MESSAGE BYTE
	ENDIF		;Z3MSG NE 0
;
	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	READBUF		;INPUT COMMAND LINE FROM USER (OR $$$.SUB)
;
	IF	Z3MSG NE 0
	XRA	A		;NORMAL PROCESSING RESUMED
	STA	Z3MSG+7		;ZEX MESSAGE BYTE
	ENDIF
;
	POP	H		;GET PTR
	MOV	A,M		;CHECK FOR COMMENT LINE
	CPI	COMMENT		;BEGINS WITH COMMENT CHAR?
	JRZ	RS0		;INPUT ANOTHER LINE IF SO
;
; PROCESS INPUT LINE; NXTCHR PTS TO FIRST LETTER OF COMMAND
;
RS1:
	LXI	SP,STACK	;RESET STACK
;
; RETURN TO CURRENT DIRECTORY AND POINT TO NEXT CHAR IN COMMAND LINE
;
	CALL	DLOGIN		;RETURN TO CURRENT DIRECTORY
	LHLD	NXTCHR		;PT TO FIRST CHAR OF NEXT COMMAND
	PUSH	H		;SAVE PTR
;
; 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
	POP	H		;GET PTR TO FIRST CHAR IN LINE
;
; SET POINTER FOR MULTIPLE COMMAND LINE PROCESSING TO FIRST CHAR OF NEW CMND
;
RS2:
	CALL	SKSP		;SKIP OVER SPACES
	ORA	A		;END OF LINE?
	JRZ	RESTRT
	CPI	CTRLC		;ABORT CHAR?
	JRZ	RESTRT
;
	IF	MULTCMD		;MULTIPLE COMMANDS ALLOWED?
	MOV	A,M		;GET FIRST CHAR OF COMMAND
	CPI	CMDSEP		;IS IT A COMMAND SEPARATOR?
	JRNZ	RS3
	INX	H		;SKIP IT IF IT IS
	JR	RS2
	ENDIF		;MULTCMD
;
RS3:
	SHLD	NXTCHR		;SET PTR TO FIRST CHAR OF NEW COMMAND LINE
	SHLD	CURCMD		;SAVE PTR TO COMMAND LINE FOR ERROR RETURN
;
; PARSE COMMAND LINE PTED TO BY HL
;
	CALL	PARSER		;PARSE ENTIRE COMMAND LINE
;
; CHECK FOR SHELL INVOCATION AND RUN IT IF SO
;
	IF	Z3MSG NE 0
	LDA	Z3MSG+3		;GET COMMAND STATUS
	CPI	1		;SHELL?
	JZ	RS4
	ENDIF		;Z3MSG NE 0
;
; IF IFON AND FCP AVAILABLE, TRY TO RUN FROM FCP
;
	IF	IFON AND (FCP NE 0)
	LXI	H,FCP+5		;PT TO COMMAND TABLE
	CALL	CMDSCAN		;SCAN TABLE
	JZ	CALLP		;RUN IF FOUND (NO LEADING CRLF)
	ENDIF		;IFON AND (FCP NE 0)
;
; IF IFON, THEN CHECK FOR RUNNING IF AND FLUSH COMMAND LINE IF ENABLED
;
	IF	IFON
	LXI	H,Z3MSG+1	;PT TO IF BYTE
	MOV	A,M		;GET IT
	ORA	A		;SEE IF ANY IF
	JRZ	RS4		;CONTINUE IF NOT
	INX	H		;PT TO IF ACTIVE BYTE
	ANA	M		;SEE IF CURRENT IF IS ACTIVE
	JRZ	RS1		;SKIP IF NOT
	ENDIF		;IFON
RS4:
;
; IF DIR: PREFIX, HANDLE AS COM FILE
;
COLON	EQU	$+1		;FLAG FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;COMMAND OF THE FORM 'DIR:COMMAND'?
	ORA	A		;0=NO
	JNZ	COMDIR		;PROCESS AS COM FILE IF DIR: FORM
;
; CHECK FOR RESIDENT COMMAND
;
	CALL	CMDSER		;SCAN FOR CPR-RESIDENT COMMAND
	JZ	CALLP		;RUN CPR-RESIDENT COMMAND WITH NO LEADING CRLF
;
; CHECK FOR RESIDENT COMMAND PACKAGE
;
	IF	RCP NE 0
	LXI	H,RCP+5		;PT TO RCP COMMAND TABLE
	CALL	CMDSCAN		;CHECK FOR RCP
	JZ	CALLPROG
	ENDIF
;
; PROCESS AS COM FILE
;
	JMP	COM		;PROCESS COM FILE

;
; ERROR PROCESSOR
;
ERROR:
;
	IF	SUBON		;IF SUBMIT FACILITY IS ON
;
	CALL	SUBKIL		;TERMINATE ACTIVE $$$.SUB IF ANY
;
	ENDIF		;SUBON
;
	CALL	CRLF		;NEW LINE
;
	IF	Z3MSG NE 0	;MESSAGES ENABLED?
;
	LDA	Z3MSG+3		;WAS ERROR CAUSED BY NO SHELL?
	ANI	1		;BIT 0 SAYS ZCPR3 TRIED TO RUN A SHELL
	JRNZ	ERRSH		;ABORT SHELL
	LDA	Z3MSG		;GET ERROR HANDLER MESSAGE
	MOV	B,A		;... IN B
	ORA	A		;FLUSH AND RESUME?
	JRZ	ERR0
	MVI	A,2		;SET ERROR FLAG
	STA	Z3MSG+3		;IN SHELL STATUS BUFFER
	LHLD	CURCMD		;PT TO BEGINNING OF ERROR
	SHLD	Z3MSG+4		;SAVE IN MESSAGE
	LXI	H,Z3MSG+10H	;PT TO COMMAND LINE
	SHLD	NXTCHR		;NEXT CHARACTER TO EXECUTE
	JMP	RS1		;RUN CONTENTS OF BUFFER
;
; CLEAR SHELL STACK AND RESTART COMMAND PROCESSING
;
ERRSH:
;
	IF	SHSTK NE 0	;IF SHELL STACK AVAILABLE
	XRA	A		;CLEAR SHELL STACK
	STA	SHSTK
	ENDIF
;
	JMP	RESTRT		;RESTART PROCESSING
ERR0:
;
	ENDIF		;Z3MSG NE 0
;
CURCMD	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	LXI	H,0		;PT TO BEGINNING OF COMMAND LINE
ERR1:
	MOV	A,M		;GET CHAR
	ORA	A		;END OF LINE?
	JRZ	ERR2
	CALL	CONOUT		;PRINT COMMAND CHAR
	INX	H		;PT TO NEXT CHAR
	JR	ERR1		;CONTINUE
ERR2:
	CALL	PRINT		;PRINT '?'
	DB	'?'+80H
ERR3:
	JMP	RESTRT		;RESTART CPR

;
; PARSE COMMAND LINE PTED TO BY HL
;   RETURN WITH NZ IF ERROR IN COMMAND NAME
;
PARSER:
;
; INITIALIZE THE COMMAND AND TOKEN FCBS
;
	LXI	D,FCBDN		;PT TO COMMAND FCB
	CALL	INITFCB		;INIT IT
	LXI	D,TFCB		;PT TO TOKEN FCB
	CALL	INITFCB		;INIT IT
;
; EXTRACT COMMAND NAME
;
	LXI	D,FCBDN		;PLACE COMMAND NAME INTO COMMAND FCB
	CALL	SCANNER		;EXTRACT COMMAND NAME
	JRNZ	ERROR		;ERROR RETURN
;
; CHECK FOR ERROR IN COMMAND NAME (FILE TYPE GIVEN)
;
	LXI	D,FCBFT		;PT TO FILE TYPE
	LDAX	D		;GET FIRST CHAR OF FILE TYPE
	CPI	' '		;MUST BE BLANK, OR ERROR
	JRNZ	ERROR		;ERROR RETURN
;
; SET TYPE OF COMMAND
;
	PUSH	H		;SAVE PTR TO NEXT BYTE
	LXI	H,COMMSG	;PLACE DEFAULT FILE TYPE (COM) INTO FCB
	MVI	B,3		;3 BYTES
	CALL	LDIR
	POP	H		;GET PTR TO NEXT BYTE
;
; SET DIR: PREFIX FLAG
;
MYCOLON	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;PREVIOUS TOKEN CONTAINED A COLON?
	STA	COLON
;
; SAVE POINTER TO COMMAND TAIL FOR LATER COPY INTO TBUFF AND FIND END OF
;   COMMAND LINE; THIS IS ALSO THE ENTRY POINT FOR CMDRUN FACILITY TO
;   PARSE THE ENTIRE COMMAND LINE AS A TAIL
;
PARSET:
	SHLD	TAILSV		;SAVE PTR TO COMMAND TAIL
	PUSH	H		;SAVE PTR
CTAIL:
	MOV	A,M		;GET CHAR
	CALL	TSTEOL		;AT EOL?
	JRZ	CTAIL1
	INX	H		;PT TO NEXT
	JR	CTAIL
CTAIL1:
	SHLD	NXTCHR		;SAVE PTR TO NEXT LINE
	POP	H		;GET PTR TO COMMAND TAIL
;
;  EXTRACT FIRST TOKEN
;
	CALL	SKSP		;SKIP OVER SPACES
	RZ			;DONE IF EOL OR END OF COMMAND
	LXI	D,TFCB		;STORE FIRST TOKEN IN TFCB
	CALL	SCANNER		;EXTRACT TOKEN
;
;  EXTRACT SECOND TOKEN
;
	CALL	SKSP		;SKIP OVER SPACES
	RZ			;DONE IF EOL OR END OF COMMAND
	LXI	D,TFCB+16	;PT TO 2ND FCB AND FALL THRU TO SCANNER
;
; EXTRACT TOKEN FROM COMMAND LINE AND PLACE IT INTO FCB PTED TO BY DE
;   FORMAT FCBDN FCB IF TOKEN RESEMBLES FILE NAME AND TYPE (FILENAME.TYP)
;     ON INPUT, HL PTS TO NEXT CHAR AND DE PTS TO FCB
;     ON OUTPUT, HL PTS TO DELIMITER AFTER TOKEN AND ZERO FLAG IS RESET
;       IF '?' IS IN TOKEN
;
; ENTRY POINTS:
;	SCANNER - LOAD TOKEN INTO FCB PTED TO BY DE
;
SCANNER:
	XRA	A		;A=0
	STAX	D		;SET DEFAULT DRIVE
	STA	MYCOLON		;SET NO COLON
	STA	TEMPDR		;SET TEMPORARY DRIVE NUMBER TO DEFAULT
	STA	QMCNT		;ZERO QUESTION MARK COUNTER
	LDA	CURUSR		;GET CURRENT USER
	STA	TEMPUSR		;SET TEMPUSR
	PUSH	D		;SAVE PTR TO FIRST BYTE OF FCB
	MVI	B,8		;8 CHARS MAX
	CALL	SCANF		;PLACE FIRST TOKEN INTO FILE NAME FIELD
	POP	D		;GET PTR TO FIRST BYTE OF FCB
	MOV	A,M		;GET TERMINATING CHAR
	STA	ENDCHAR		;SET ENDING CHAR
	CPI	':'		;COLON?
	JRNZ	SCAN1		;NO, WE HAVE A FILE NAME
	STA	MYCOLON		;SET COLON
	INX	H		;PT TO CHAR AFTER COLON
;
;  SCAN TOKEN FOR DIR: FORM, WHICH MEANS WE HAVE A USER/DISK SPECIFICATION
;    HL PTS TO CHAR AFTER COLON
;
	IF	(Z3NDIR NE 0) AND NDINCP	;NAMED DIRS AVAILABLE
;
	IF	DUFIRST	;DU: BEFORE DIR:
;
; CHECK FOR DU: FORM
;
	IF	ACCPTDU	;PERMIT DU: FORM
	PUSH	D		;SAVE PTR TO FCB DN
	PUSH	H		;SAVE PTR TO NEXT CHAR IN LINE
	CALL	DUSCAN		;CHECK FOR DU: FORM
	POP	H		;GET PTR TO NEXT CHAR
	POP	D		;GET PTR TO FCB
	JRZ	SUD1		;GOT IT
	ENDIF		;ACCPTDU
;
; CHECK FOR DIR: FORM
;
	IF	ACCPTND	;PERMIT DIR: FORM
	PUSH	D		;SAVE PTR TO FCB
	PUSH	H		;SAVE PTR TO NEXT CHAR
	CALL	DIRSCAN		;CHECK FOR DIR: FORM
	POP	H		;GET PTR TO NEXT CHAR
	POP	D		;GET PTR TO FCB
	JRNZ	SCAN1		;ERROR IN PREFIX
	ENDIF		;ACCPTND
SUD1:
;
	ELSE		;DIR: BEFORE DU:
;
; CHECK FOR DIR: FORM
;
	IF	ACCPTND	;PERMIT DIR: FORM
	PUSH	D		;SAVE PTR TO FCB
	PUSH	H		;SAVE PTR TO NEXT CHAR
	CALL	DIRSCAN		;CHECK FOR DIR: FORM
	POP	H		;GET PTR TO NEXT CHAR
	POP	D		;GET PTR TO FCB
	JRZ	SUD1		;GOT IT
	ENDIF		;ACCPTND
;
; CHECK FOR DU: FORM
;
	IF	ACCPTDU	;PERMIT DU: FORM
	PUSH	D		;SAVE PTR TO FCB DN
	PUSH	H		;SAVE PTR TO NEXT CHAR IN LINE
	CALL	DUSCAN		;CHECK FOR DU: FORM
	POP	H		;GET PTR TO NEXT CHAR
	POP	D		;GET PTR TO FCB
	JRNZ	SCAN1		;ERROR IN PREFIX
	ENDIF		;ACCPTDU
SUD1:
;
	ENDIF		;DUFIRST
;
	ELSE		;DU ONLY
;
; CHECK FOR DU: FORM
;
	IF	ACCPTDU	;ALLOW DU: FORM
	PUSH	D		;SAVE PTR TO FCB DN
	PUSH	H		;SAVE PTR TO NEXT CHAR IN LINE
	CALL	DUSCAN		;CHECK FOR DU: FORM
	POP	H		;GET PTR TO NEXT CHAR
	POP	D		;GET PTR TO FCB
	JRNZ	SCAN1		;ERROR IN PREFIX
	ENDIF		;ACCPTDU
;
	ENDIF		;(Z3NDIR NE 0) AND NDINCP
;
; SET DRIVE REFERENCED
;
	LDA	TEMPDR		;SET DRIVE
	STAX	D		;... IN FCB
;
; REINIT FCB PTED TO BY DE
;
	PUSH	D		;SAVE PTR
	INX	D		;PT TO FN FIELD
	CALL	IFCB		;ONLY PARTIAL INIT (17 BYTES TOTAL)
	POP	D
;
; EXTRACT FILENAME FIELD
;
	XRA	A
	STA	QMCNT		;ZERO QUESTION MARK COUNTER
	PUSH	D		;SAVE PTR TO FIRST BYTE OF FCB
	MVI	B,8		;8 CHARS MAX
	CALL	SCANF		;STORE FILE NAME
	POP	D		;GET PTR TO FIRST BYTE OF FCB
	MOV	A,M		;GET OFFENDING CHAR
	STA	ENDCHAR		;SET ENDING CHAR
;
; SKIP TO FILE TYPE FIELD
;   HL PTS TO NEXT CHAR, DE PTS TO DN FIELD OF FCB
;
SCAN1:
ENDCHAR	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;GET ENDING CHAR
	XCHG
	LXI	B,8		;PT TO BEFORE FILE TYPE FIELD OF FCB
	DAD	B
	XCHG
;
; EXTRACT FILETYPE FIELD
;
	MVI	B,3		;PREPARE TO EXTRACT FILE TYPE
	CPI	'.'		;IF '.', WE HAVE A TYPE
	JRNZ	SCAN2
	INX	H		;PT TO CHAR AFTER '.'
	PUSH	D
	CALL	SCANF		;GET FCB FILE TYPE
	POP	D
SCAN2:
;
; SET USER NUMBER REFERENCED
;   HL PTS TO NEXT CHAR, DE PTS TO BEFORE FCB FT
;
	XCHG
	LXI	B,5		;PT TO S1 FIELD
	DAD	B
	XCHG
	LDA	TEMPUSR		;STORE USER NUMBER HERE
	STAX	D
;
; SKIP TO SPACE, CHAR AFTER =,  OR EOL
;   HL PTS TO NEXT CHAR IN LINE
;
SCAN3:
	MOV	A,M		;GET NEXT CHAR
	CPI	' '+1		;DONE IF LESS THAN SPACE
	JRC	SCAN4
	CALL	TSTEOL		;EOL?
	JRZ	SCAN4
	INX	H		;PT TO NEXT
	CPI	'='		;EQUATE?
	JRNZ	SCAN3
SCAN4:
;
; SET ZERO FLAG TO INDICATE PRESENCE OF '?' IN DIR:FILENAME.TYP
;
QMCNT	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;NUMBER OF QUESTION MARKS
	ORA	A		;SET ZERO FLAG
	RET
;
;  SCANF -- SCAN TOKEN PTED TO BY HL FOR A MAX OF B BYTES; PLACE IT INTO
;    FILE NAME FIELD PTED TO BY DE; EXPAND AND INTERPRET WILD CARDS OF
;    '*' AND '?'; ON EXIT, DE PTS TO TERMINATING DELIMITER
;
SCANF:
	CALL	SDELM		;DONE IF DELIMITER ENCOUNTERED
	RZ
	INX	D		;PT TO NEXT BYTE IN FCB
	CPI	'*'		;IS (DE) A WILD CARD?
	JRNZ	SCANF1		;CONTINUE IF NOT
	MVI	A,'?'		;PLACE '?' IN FCB AND DON'T ADVANCE HL IF SO
	STAX	D
	CALL	SCQ		;SCANNER COUNT QUESTION MARKS
	JR	SCANF2
SCANF1:
	STAX	D		;STORE FILENAME CHAR IN FCB
	INX	H		;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	H		;PT TO NEXT CHAR IN COMMAND LINE
	JR	SCANF3
;
;  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
;
;  SCAN FOR AND EXTRACT DISK/USER INFO ASSUMING DU: FORM
;    ON ENTRY, DE PTS TO FIRST BYTE OF FCB CONTAINING POSSIBLE DU FORM
;    ON EXIT, ZERO FLAG SET MEAN OK AND TEMPDR AND TEMPUSR SET
;
	IF	ACCPTDU	;ALLOW DU: FORM
DUSCAN:
	XCHG			;PTR IN HL
	INX	H		;PT TO FIRST BYTE OF FN
	MOV	A,M		;GET FIRST CHAR
	CPI	'A'		;CONVERT POSSIBLE DRIVE SPEC TO NUMBER
	JRC	DUS1		;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?
	JRNC	DUSE1		;INVALID DISK NUMBER
	STA	TEMPDR		;SET TEMPORARY DRIVE NUMBER
	INX	H		;PT TO NEXT CHAR
	MOV	A,M		;SEE IF IT IS A SPACE
	CPI	' '
	RZ
	CALL	DIGCK		;CHECK FOR DIGIT
	RC
;
;  SET USER NUMBER
;
DUS1:
	PUSH	H		;SAVE PTR TO DIGITS
	MVI	B,2		;UP TO 2 DIGITS
DUS1A:
	MOV	A,M		;CHECK FOR DIGIT OR SPACE
	CPI	' '		;IF SPACE, THEN NO DIGIT
	JRZ	DUS2
	CALL	DIGCK		;CHECK FOR DIGIT
	JRC	DUSE
	INX	H
	DJNZ	DUS1A		;COUNT DOWN
	MOV	A,M		;3RD CHAR
	CPI	' '		;MUST BE SPACE
	JRNZ	DUSE
DUS2:
	POP	H
	CALL	NUM0A		;GET NUMBER
	CPI	MAXUSR+1	;WITHIN LIMIT?
	JRNC	DUSE1
	STA	TEMPUSR		;SAVE USER NUMBER
	XRA	A		;SET OK
	RET
DUSE:
	POP	H		;CLEAR STACK
DUSE1:
	XRA	A
	DCR	A
	RET
;
	ENDIF		;ACCPTDU
;
	IF	(Z3NDIR NE 0) AND NDINCP AND ACCPTND
;
;  SCAN FOR DIR FORM
;    ON ENTRY, DE PTS TO FCB CONTAINING NAME TO CHECK FOR
;    ON EXIT, IF FOUND, Z AND TEMPUSR AND TEMPDR SET
;
DIRSCAN:
	XCHG			;PTR IN HL
	INX	H		;PT TO FN
	LXI	D,Z3NDIR	;PT TO FIRST ENTRY IN MEMORY-BASED DIR
DIRS1:
	LDAX	D		;GET NEXT CHAR
	ORA	A		;ZERO IF END OF DIR
	JRZ	DIRSERR
	INX	D		;PT TO DIR NAME
	INX	D
	PUSH	H		;SAVE PTR TO FILE NAME
	PUSH	D		;SAVE PTR TO DIR ENTRY
	MVI	B,8		;MATCH?
DIRS2:
	LDAX	D		;GET BYTE
	CMP	M		;COMPARE
	JRNZ	DIRS3
	INX	H		;PT TO NEXT
	INX	D
	DJNZ	DIRS2		;COUNT DOWN
DIRS3:
	POP	D		;RESTORE REGS
	POP	H
	JRZ	DIRS4
	XCHG			;ADVANCE TO NEXT ENTRY
	LXI	B,16		;8 BYTES FOR NAME + 8 BYTES FOR PASSWORD
	DAD	B
	XCHG
	JR	DIRS1
;
; NO DIR match
;
DIRSERR:
	XRA	A		;RETURN NZ
	DCR	A
	RET
;
; DIR match
;
DIRS4:
;
	IF	PWCHECK
	PUSH	D		;SAVE PTR TO DE
	LXI	B,8		;PT TO PW
	XCHG			;HL PTS TO ENTRY
	DAD	B
	CALL	PASSCK		;CHECK FOR PW
	POP	D		;GET PTR
	JNZ	DIRSERR
	ENDIF		;PWCHECK
;
	DCX	D		;PT TO USER
	LDAX	D		;GET USER
	STA	TEMPUSR
	DCX	D		;PT TO DISK
	LDAX	D		;GET IT
	STA	TEMPDR		;A=1
	XRA	A		;SET Z
	RET
;
	ENDIF		;(Z3NDIR NE 0) AND NDINCP AND ACCPTND
;
	IF	PWCHECK
;
; CHECK FOR PASSWORD PTED TO BY HL
;   RETURN WITH ZERO FLAG SET IF MATCH
;
PASSCK:
	MOV	A,M	;CHECK FOR NO PW
	CPI	' '
	RZ
	PUSH	H	;SAVE PTR
	CALL	PRINT
	DB	CR,LF,'PW?',' '+80H
	LXI	D,PWLIN
	MVI	A,9	;SET CHAR COUNT
	STAX	D
	MVI	C,10	;BDOS READLN
	PUSH	D
	CALL	BDOS
	POP	H	;GET PTR TO BUFFER
	INX	H	;PT TO CHAR COUNT
	MOV	A,M	;GET CHAR COUNT
	INX	H	;PT TO FIRST CHAR
	PUSH	H	;SAVE PTR
	CALL	ADDAH	;HL PTS TO AFTER LAST CHAR
	MVI	M,' '	;PLACE SPACE
	POP	D	;PT TO USER INPUT
	POP	H	;PT TO PASSWORD
	MVI	B,8	;8 CHARS MAX
PWCK:
	LDAX	D	;GET NEXT CHAR
	CALL	UCASE	;CAPITALIZE USER INPUT
	CMP	M	;COMPARE FOR MATCH
	RNZ		;NO MATCH
	CPI	' '	;DONE?
	RZ
	INX	H	;PT TO NEXT
	INX	D
	DJNZ	PWCK
	XRA	A	;SET ZERO FLAG
	RET
;
	ENDIF		;PWCHECK

;
; SKIP OVER SPACES PTED TO BY HL
;   ON RETURN, ZERO FLAG SET MEANS WE HIT EOL OR CMDSEP
;
SKSP:
	MOV	A,M	;GET NEXT CHAR
	INX	H	;PT TO NEXT
	CPI	' '	;SPACE?
	JRZ	SKSP
	DCX	H	;PT TO NON-SPACE
;
; CHECK TO SEE IF CHAR IN A IS EOL OR CMDSEP
;
TSTEOL:
	ORA	A	;EOL?
;
	IF	MULTCMD	;MULTIPLE COMMANDS SUPPORTED?
	RZ		;RETURN WITH FLAG
	CPI	CMDSEP	;COMMAND SEPARATOR?
	ENDIF		;MULTCMD
;
	RET

;
; INIT FCB PTED TO BY DE
;
INITFCB:
	XRA	A
	STAX	D	;SET DEFAULT DISK (DN BYTE IS 0)
	INX	D	;PT TO FILE NAME FIELD
	CALL	IFCB	;FILL 1ST PART OF FCB; FALL THRU TO IFCB TO RUN AGAIN
;
; FILL FN, FT, EX, S1, S2, RC, AND FOLLOWING CR (OR DN) FIELDS
;
IFCB:
	MVI	B,11	;STORE 11 SPACES
	MVI	A,' '
	CALL	FILL
	XRA	A
	STAX	D	;SET EX TO ZERO
	INX	D
	LDA	CURUSR
	STAX	D	;SET S1 TO CURRENT USER
	INX	D
	MVI	B,3	;STORE 3 ZEROES
	XRA	A	;FALL THRU TO FILL
;
; FILL MEMORY POINTED TO BY DE WITH CHAR IN A FOR B BYTES
;
FILL:
	STAX	D		;FILL WITH BYTE IN A
	INX	D		;PT TO NEXT
	DJNZ	FILL
	RET
;
; 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
;
CONIN:
	MVI	C,1	;INPUT CHAR
	CALL	BDOS	;GET INPUT CHAR WITH ^S PROCESSING AND ECHO
	JMP	UCASE	;CAPITALIZE
;
; OUTPUT <CRLF>
;
CRLF:
	MVI	A,CR
	CALL	CONOUT
	MVI	A,LF	;FALL THRU TO CONOUT
;
CONOUT:
	PUTRG		;SAVE REGS
	MVI	C,2
OUTPUT:
	MOV	E,A
	CALL	BDOS
	GETRG		;GET REGS
	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:
	PUTRG		;SAVE REGISTERS
	MVI	C,5
	JR	OUTPUT
LC1:
	POP	PSW	;GET CHAR
	PUSH	PSW
	CALL	CONOUT	;OUTPUT TO CON:
	POP	PSW
;
	IF	LTON
	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
	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	RS1		;RESTART CPR
PAGER1:
	POP	H		;RESTORE HL

	ENDIF		;LTON
;
	RET			;RETURN FOR LC1 IF NOT LTON
;
; READ FILE BLOCK FUNCTION
;
READF:
	LXI	D,TFCB	;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
;
; THIS RETURN IS FOR BDOSB AND FOR THE NULL FUNCTION CALLED NOTE
;
NOTE:
	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,TFCB	;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 ****
; ZCPR3 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
;
; PRINT DU (DIR) PROMPT
;
PROMPT:
;
; PRINT PROMPT (DU>)
;
	CALL	CRLF		;PRINT PROMPT
;
	IF	INCLDU		;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	PRMPT2
	ENDIF		;SUPRES
;
	CPI	10		;USER < 10?
	JRC	PRMPT1
	SUI	10		;SUBTRACT 10 FROM IT
	PUSH	PSW		;SAVE IT
	MVI	A,'1'		;OUTPUT 10'S DIGIT
	CALL	CONOUT
	POP	PSW
PRMPT1:
	ADI	'0'		;OUTPUT 1'S DIGIT (CONVERT TO ASCII)
	CALL	CONOUT
PRMPT2:
	ENDIF		;INCLDU
;
; PRINT NDIR ENTRY IF ANY
;
	IF	INCLNDR AND (Z3NDIR NE 0)
;
	LDA	CURDR		;GET CURRENT DU IN BC
	INR	A
	MOV	B,A
	LDA	CURUSR
	MOV	C,A
	LXI	H,Z3NDIR	;SCAN DIRECTORY FOR MATCH
;
; MAIN LOOP FOR SCANNING NDR FOR DU IN BC
;
PRMPT3:
	MOV	A,M		;END OF NDR?
	ORA	A
	RZ
	INX	H		;PT TO USER
	CMP	B		;COMPARE DISK
	JRNZ	PRMPT5
	MOV	A,M		;COMPARE USER
	CMP	C
	JRNZ	PRMPT5
;
; MATCH OF DU
;
	IF	INCLDU		;SEPARATE DU AND NDR WITH COLON
	MVI	A,':'		;PRINT SEPARATOR
	CALL	CONOUT
	ENDIF		;INCLDU
;
	MVI	B,8		;8 CHARS MAX
PRMPT4:
	INX	H		;PT TO NEXT CHAR
	MOV	A,M		;GET NEXT CHAR
	CPI	' '		;DONE IF SPACE
	RZ
	CALL	CONOUT		;PRINT CHAR
	DJNZ	PRMPT4		;COUNT DOWN
	RET
;
; ADVANCE TO NEXT DU
;
PRMPT5:
	LXI	D,16+1		;SKIP USER (1 BYTE) AND NAME/PW (16 BYTES)
	DAD	D
	JR	PRMPT3		;CONTINUE SCAN
;
	ENDIF		;INCLNDR AND (Z3NDIR NE 0)
;
	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
;
READBUF:
;
	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
	MVI	B,BUFLEN	;NUMBER OF BYTES
	CALL	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
	CALL	PROMPT		;PRINT PROMPT
	MVI	A,SPRMPT	;PRINT SUBMIT PROMPT TRAILER
	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
;
;  IF SHELL STACKS ARE IMPLEMENTED, CHECK FOR CONTENT AT THIS TIME
;
	IF	SHSTK NE 0
;
	LXI	H,SHSTK		;PT TO STACK
	MOV	A,M		;CHECK FIRST BYTE
	CPI	' '+1		;SEE IF ANY ENTRY
	JRC	RB2		;GET USER INPUT IF NONE
;
	ENDIF		;SHSTK NE 0
;
	IF	(SHSTK NE 0) OR (Z3MSG NE 0)
;
RUNBUF:
	LXI	D,CMDLIN	;PT TO FIRST CHAR OF COMMAND LINE
	MVI	B,SHSIZE	;COPY SHELL LINE INTO COMMAND LINE BUFFER
	CALL	LDIR		;DO COPY
	XCHG			;HL PTS TO END OF LINE
	MVI	A,1		;SAY SHELL WAS INVOKED
	STA	Z3MSG+3		;Z3 OUTPUT MESSAGE
	JR	RB3		;STORE ENDING ZERO AND EXIT
RB2:
;
	ENDIF		;(SHSTK NE 0) OR (Z3MSG NE 0)
;
	CALL	PROMPT		;PRINT PROMPT
	MVI	A,CPRMPT	;PRINT PROMPT TRAILER
	CALL	CONOUT
	MVI	C,0AH		;READ COMMAND LINE FROM USER
	LXI	D,BUFSIZ	;PT TO BUFFER SIZE BYTE OF COMMAND LINE
	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
RB3:
	MVI	M,0		;STORE ENDING ZERO
	RET
;
; CHECK FOR ANY CHAR FROM USER CONSOLE; RET W/ZERO SET IF NONE
;
BREAK:
	PUTRG			;SAVE REGISTERS
	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
	GETRG			;RESTORE REGISTERS
	CPI	'C'-'@'		;CHECK FOR ABORT
	RET

;
; CHECK TO SEE IF HL PTS TO DELIMITER; IF SO, RET W/ZERO FLAG SET
;
SDELM:
	MOV	A,M		;GET NEXT CHAR FROM LINE
	CPI	' '+1		;DELIM IF <= <SP>
	JRC	ZERO
	CPI	'='		;'='=DELIMITER
	RZ
	CPI	5FH		;UNDERSCORE=DELIMITER
	RZ
	CPI	'.'		;'.'=DELIMITER
	RZ
	CPI	':'		;':'=DELIMITER
	RZ
	CPI	','		;','=DELIMITER
	RZ
;
	IF	CMDSEP NE ';'
	CPI	';'		;';'=DELIMITER
	RZ
	ENDIF
;
	CPI	'<'		;'<'=DELIMITER
	RZ
	CPI	'>'		;'>'=DELIMITER
	RZ
	JMP	TSTEOL		;CHECK FOR EOL
ZERO:
	XRA	A	;SET ZERO FLAG
	RET
;
; ADD A TO HL (HL=HL+A)
;
ADDAH:
	ADD	L
	MOV	L,A
	RNC
	INR	H
	RET
;
; COPY FROM HL TO DE FOR B BYTES
;
LDIR:
	MOV	A,M	;GET BYTE
	STAX	D	;PUT BYTE
	INX	H	;PT TO NEXT
	INX	D
	DJNZ	LDIR
	RET
;
; EXTRACT DECIMAL NUMBER FROM COMMAND LINE
;   RETURN WITH VALUE IN REG A; ALL REGISTERS MAY BE AFFECTED
;
NUMBER:
	LXI	H,TFCB+8 	;PT TO END OF TOKEN FOR CONVERSION
	MVI	B,8		;8 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	HEXNUM
;
; PROCESS DECIMAL NUMBER
;
NUM0:
	LXI	H,TFCB+1	;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
	CALL	SDELM		;DONE IF DELIMITER
	JRZ	NUM2
	INX	H		;PT TO NEXT CHAR
	CALL	DIGCK		;CHECK FOR DIGIT IN A
	JRC	NUMERR
	MOV	D,A		;DIGIT IN D
	MOV	A,C		;NEW VALUE = OLD VALUE * 10
	RLC			;*2
	JRC	NUMERR
	RLC			;*4
	JRC	NUMERR
	ADD	C		;*5
	JRC	NUMERR
	RLC			;*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
;
; CHECK TO SEE IF A IS A DIGIT
;   IF SO, RETURN ITS VALUE
;   IF NOT, RETURN WITH CARRY SET
;
DIGCK:
	SUI	'0'		;DIGIT?
	RC			;ERROR
	CPI	10		;RANGE?
	JRNC	DIGCK1
	CMC			;FLIP CARRY
	RET
DIGCK1:
	STC			;SET CARRY
	RET
;
; EXTRACT HEXADECIMAL NUMBER FROM COMMAND LINE
;   RETURN WITH VALUE IN REG A; ALL REGISTERS MAY BE AFFECTED
;
HEXNUM:
	LXI	H,TFCB+1	;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
;
; LOG INTO DU CONTAINED IN FCB PTED TO BY DE
;
FCBLOG:
	PUSH	D		;SAVE PTR TO FCB
	XCHG
	MOV	A,M		;GET DRIVE
	STA	TEMPDR		;SET TEMP DRIVE
	LXI	B,13		;PT TO S1 FIELD
	DAD	B
	MOV	A,M		;GET USER
	STA	TEMPUSR		;SET TEMP USER
	CALL	SLOGIN		;LOG IN
	POP	D		;GET PTR TO FCB
	RET
;
; CHECK FOR SPECIFIED DRIVE AND LOG IT IN
;
SLOGIN:
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
;
;  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	Z3WHL		;GET WHEEL BYTE
	ORA	A		;ZERO?
	RNZ			;OK IF NOT
	JMP	ERROR		;PROCESS AS ERROR
	ENDIF		;WHEEL
;

;
; CMDTBL (COMMAND TABLE) SCANNER
;   ON RETURN, HL CONTAINS ADDRESS OF COMMAND IF CPR-RESIDENT
;   ON RETURN, ZERO FLAG SET MEANS CPR-RESIDENT COMMAND
;
CMDSER:
	LXI	H,CMDTBL	;PT TO COMMAND TABLE
;
; ENTRY POINT TO PERMIT RCP TABLE TO BE SCANNED
;
CMDSCAN:
	MOV	B,M		;GET SIZE OF COMMAND TEXT
	INX	H		;PT TO FIRST COMMAND
CMS1:
	MOV	A,M		;CHECK FOR END OF TABLE
	ORA	A
	JRZ	CMS5
	LXI	D,FCBFN 	;PT TO STORED COMMAND NAME
	PUSH	B		;SAVE SIZE OF COMMAND TEXT
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
	POP	B		;CLEAR STACK
	MOV	A,M		;GET ADDRESS FROM TABLE INTO HL
	INX	H
	MOV	H,M
	MOV	L,A		;HL CONTAINS ADDRESS
	XRA	A		;ZERO FLAG SET FOR COMMAND FOUND
	RET			;COMMAND IS RESIDENT (ZERO FLAG SET)
CMS3:
	INX	H		;SKIP TO NEXT COMMAND TABLE ENTRY
	DJNZ	CMS3
CMS4:
	POP	B		;GET SIZE OF COMMAND TEXT
	INX	H		;SKIP ADDRESS
	INX	H
	JR	CMS1
CMS5:
	XRA	A		;SET NZ
	DCR	A		;COMMAND NOT FOUND IF NZ
	RET

;
;**** 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:
	LXI	D,TFCB		;PT TO TARGET FCB
	PUSH	D		;SAVE PTR
	INX	D		;PT TO FILE NAME
	LDAX	D		;GET FIRST CHAR
	CPI	' '		;IF <SP>, MAKE ALL WILD
	JRNZ	DIR1
	MVI	B,11		;11 BYTES
	MVI	A,'?'		;WILD
	CALL	FILL
DIR1:
	POP	D		;GET PTR TO FCB
	LXI	D,TFCB		;PT TO TARGET FCB
	CALL	FCBLOG		;LOG IN TEMP DISK/USER
	LDA	TFCB2+1		;LOOK AT NEXT INPUT CHAR
	MVI	B,80H		;PREPARE FOR DIR-ONLY SELECTION
	CPI	' '
	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
				;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 OCCURRENCE)
	JRNZ	DIR3
	CALL	PRNNF		;PRINT NO FILE MSG; REG A NOT CHANGED
	XRA	A		;SET ZERO FLAG IN CASE CALLED BY ERA
	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		;GET ENTRY COUNTER
	INR	E		;INCREMENT ENTRY COUNTER
	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
	MVI	A,1		;PT TO 1ST BYTE OF FILE NAME
	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
;
; 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
;
; 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
;
;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
;
	IF	ERAV AND ERAOK	;V FLAG AND OK? ENABLED?
	LDA	TFCB2+1		;GET ERAFLG IF IT'S THERE
	STA	ERAFLG		;SAVE IT AS A FLAG
	ENDIF			;ERAV
;
	LXI	D,TFCB		;PT TO TARGET FCB
	CALL	FCBLOG		;LOG INTO DU IN FCB
	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,TFCB 		;DELETE FILE SPECIFIED
	JMP	DELETE		;DELETE FILE AND REENTER CCP
;
	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
;
	LDA	TFCB2+1		;GET PGDFLG IF IT'S THERE
	STA	PGFLG		;SAVE IT AS A FLAG
	LXI	D,TFCB		;PT TO TARGET FILE FCB
	CALL	AMBCHK		;CHECK FOR QUESTION MARKS IN TFCB
	RZ			;ERROR IF ANY QUESTION MARKS
	CALL	FCBLOG		;LOG INTO DU IN FCB
	LXI	D,TFCB		;PT TO SELECT FILE
	CALL	OPEN		;OPEN SELECTED FILE
	JZ	PRNNF		;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
	RNZ			;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
;
	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
	LXI	H,TFCB2		;COPY 2ND FCB INTO POSITION OF FIRST
	LXI	D,TFCB
	PUSH	D		;SAVE PTR TO FCB
	MVI	B,14		;14 BYTES
	CALL	LDIR
	POP	D		;GET PTR TO FCB
	CALL	AMBCHK		;CHECK FOR AMBIGUOUS
	POP	H
	RZ			;ABORT IF SO
	PUSH	H
	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?
	LXI	D,TPA-128	;PT TO START OF SAVE AREA (TPA)
	DAD	H		;DOUBLE 256-BYTE BLOCK COUNT FOR SECTOR COUNT
	XCHG			;DE IS COUNT, HL IS NEXT BLOCK - 128 BYTES
SAVE1:
	MOV	A,D		;DONE WITH SAVE?
	ORA	E		;DE=0 IF SO
	JRZ	SAVE2
	DCX	D		;COUNT DOWN ON SECTORS
	PUSH	D		;SAVE PTR TO BLOCK TO SAVE
	LXI	D,128		;128 BYTES PER SECTOR
	DAD	D		;PT TO NEXT SECTOR
	PUSH	H		;SAVE ON STACK
	XCHG			;DE IS ADDRESS
	CALL	DMASET		;SET DMA ADDRESS FOR WRITE (ADDRESS IN DE)
	LXI	D,TFCB		;WRITE SECTOR
	MVI	C,15H		;BDOS WRITE SECTOR
	CALL	BDOSB		;SAVE BC
	POP	H		;GET PTR TO NEXT SECTOR IN HL
	POP	D		;GET SECTOR COUNT IN DE
	JRNZ	SAVE3		;WRITE ERROR?
	JR	SAVE1		;CONTINUE
SAVE2:
	LXI	D,TFCB		;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
;
	IF	LTON OR SAVEON OR RENON	;FOR LIST/TYPE, SAVE, AND REN FCTS
;
; TEST FCB PTED TO BY DE TO SEE IF ANY ? CHARS IN IT
;   RETURN WITH Z IF SO, NZ IF NOT; DON'T AFFECT DE
;
AMBCHK:
	PUSH	D
	INX	D		;PT TO FIRST CHAR
	MVI	B,11		;11 CHARS
AMB1:
	LDAX	D		;GET CHAR
	CPI	'?'		;ERROR?
	JRZ	AMB2
	INX	D		;PT TO NEXT
	DJNZ	AMB1
	DCR	B		;SET NZ
	POP	D		;RESTORE PTR
	RET
AMB2:
	CALL	PRINT
	DB	CR,LF,'AFN Erro','r'+80H
	XRA	A		;SET ZERO FLAG
	POP	D		;RESTORE PTR
	RET
;
	ENDIF		;LTON OR 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:
	LXI	D,TFCB		;PT TO FCB
	PUSH	D		;SAVE PTR
	CALL	FCBLOG		;LOG INTO DU
	CALL	SEARF		;LOOK FOR SPECIFIED FILE
	POP	D		;GET PTR TO FCB
	RZ			;OK IF NOT FOUND
	PUSH	D		;SAVE PTR TO FCB
	CALL	PRINTC
	DB	'Erase',' '+80H
	LXI	H,TFCB+1	;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
;
	LXI	D,TFCB		;CHECK FOR AMBIGUITY IN FIRST FILE NAME
	CALL	AMBCHK
	RZ
	LXI	D,TFCB2		;CHECK FOR AMBIGUITY IN SECOND FILE NAME
	CALL	AMBCHK
	RZ
	CALL	EXTEST		;TEST FOR FILE EXISTENCE AND RETURN
				; IF FILE DOESN'T EXIST; ABORT IF IT DOES
	MVI	B,16		;EXCHANGE NEW AND OLD FILE NAMES
	LXI	H,TFCB		;PT TO NEW
	LXI	D,TFCB2		;PT TO OLD
REN0:
	LDAX	D		;GET OLD
	MOV	C,A
	MOV	A,M		;GET NEW
	STAX	D		;PUT NEW
	MOV	M,C		;PUT OLD
	INX	H		;ADVANCE
	INX	D
	DJNZ	REN0
;
;  PERFORM RENAME FUNCTION
;
	LXI	D,TFCB		;RENAME FILE
	XRA	A
	STAX	D		;SET CURRENT DISK
	MVI	C,17H		;BDOS RENAME FCT
	CALL	GRBDOS
	RNZ
	JMP	PRNNF		;PRINT NO FILE MSG
;
	ENDIF			;RENON
;
;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
;
COMDIR:
	IF	DRVPREFIX
;
	LDA	FCBFN		;ANY COMMAND?
	CPI	' '		;' ' MEANS COMMAND WAS 'DIR:' TO SWITCH
	JRNZ	COM		;NOT <SP>, SO MUST BE TRANSIENT OR ERROR
;
;  ENTRY POINT TO SELECT USER/DISK VIA DIR: PREFIX
;
	IF	WDU	;WHEEL FACILITY?
	CALL	WHLCHK		;CHECK FOR WHEEL BYTE
	ENDIF		;WDU
;
	LDA	FCBDN+13	;GET SELECTED USER
	CPI	16		;OUT OF RANGE?
	JNC	ERROR
	LXI	D,FCBDN		;PT TO FCB
	CALL	FCBLOG		;LOG INTO DU
	LDA	TEMPUSR		;GET TEMPORARY USER
	STA	CURUSR		;SET CURRENT USER (MAKE PERMANENT)
	LDA	TEMPDR		;GET SELECTED DISK
	ORA	A		;IF 0 (DEFAULT), NO CHANGE
	JRZ	COMDR
	DCR	A		;ADJUST FOR LOGIN
	STA	CURDR		;SET CURRENT DRIVE
COMDR:
	CALL	SETUD		;SET UD BYTE
	JMP	RS1		;RESUME COMMAND LINE PROCESSING
;
	ENDIF		;DRVPREFIX
;
;  PROCESS COMMAND
;
COM:
;
	IF	CMDRUN		;COMMAND RUN FACILITY AVAILABLE?
	MVI	A,0FFH		;USE IT IF AVAILABLE (MLOAD INPUT)
	ENDIF		;CMDRUN
;

;
; SET EXECUTION AND LOAD ADDRESS
;
	LXI	H,TPA		;TRANSIENT PROGRAM AREA
	PUSH	H		;SAVE TPA ADDRESS FOR EXECUTION
	CALL	MLOAD		;LOAD MEMORY WITH FILE SPECIFIED IN CMD LINE
	POP	H		;GET EXECUTION ADDRESS; FALL THRU TO CALLPROG
;
; 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:
	CALL	CRLF		;LEADING NEW LINE
CALLP:
	SHLD	EXECADR		;PERFORM IN-LINE CODE MODIFICATION
;
; COPY COMMAND TAIL INTO TBUFF
;
TAILSV	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	LXI	H,0		;ADDRESS OF FIRST CHAR OF COMMAND TAIL
	LXI	D,TBUFF		;PT TO TBUFF
	PUSH	D		;SAVE PTR
	MVI	B,0		;SET COUNTER
	INX	D		;PT TO FIRST CHAR
TAIL:
	MOV	A,M		;GET CHAR
	CALL	TSTEOL		;CHECK FOR EOL
	JRZ	TAIL1
	STAX	D		;PUT CHAR
	INX	H		;PT TO NEXT
	INX	D
	INR	B		;INCREMENT COUNT
	JR	TAIL
TAIL1:
	XRA	A		;STORE ENDING ZERO
	STAX	D
	POP	H		;GET PTR
	MOV	M,B		;SAVE COUNT
;
; RUN LOADED TRANSIENT PROGRAM
;
	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
;
; RETURN FROM EXECUTION
;
	CALL	DEFDMA		;SET DMA TO 0080, IN CASE PROG CHANGED IT
	JMP	RS1		;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
;
	LXI	H,TFCB2		;COPY TFCB2 TO FCBDN FOR LOAD
	LXI	D,FCBDN
	MVI	B,14		;14 BYTES (INCLUDES DU)
	CALL	LDIR
	CALL	HEXNUM		;GET LOAD ADDRESS IN HL
;
; FALL THRU TO MLOAD
;
	IF	CMDRUN		;COMMAND RUN FACILITY AVAILABLE?
	XRA	A		;NO CMDRUN IF FACILITY IS THERE (MLOAD INPUT)
	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
	XCHG			;LOAD ADDRESS IN DE
	CALL	DMASET		;SET DMA ADDRESS
;
;   MLA is a reentry point for a non-standard CP/M Modification
; The PATH command-search is implemented by this routine
;
MLA:
;
;  Set attributes of COM files which match search
;
	MVI	A,COMATT	;CUSTOMIZER-SPECIFIED ATTRIBUTES
	STA	SYSTST		;SET FLAG

;
; Analyze current path, generating a minimal, optimal absolute
;   path equivalent in the buffer MPATH
;
	IF	MINPATH		;IF MINIMUM PATH SEARCH EMPLOYED
	XRA	A
	STA	MPATH		;SET EMPTY PATH
;
	IF	DRVPREFIX	;PAY ATTENTION TO DU:COM PREFIX?
;
; Convert DU in FCBDN into absolute expression in MPATH
;
	LXI	D,MPATH		;BUILD MPATH BUFFER
	LXI	H,FCBDN		;HL PTS TO FCB, DE PTS TO MPATH
	MOV	A,M		;GET DRIVE
	ORA	A		;SELECT CURRENT
	JRNZ	MLAMPD
	LDA	CURDR		;SET CURRENT DRIVE
	INR	A		;ADJUST FOR PATH
MLAMPD:
	STAX	D		;SET DRIVE
	INX	D		;PT TO USER
	LXI	B,13		;PT TO USER
	DAD	B
	MOV	A,M		;GET USER
	STAX	D		;SAVE USER
	INX	D		;PT TO NEXT
	XRA	A		;A=0
	STAX	D		;STORE ENDING 0 IN MPATH
	ENDIF		;DRVPREFIX
;
	IF	SCANCUR		;SCAN CURRENT DU AT ALL TIMES?
	LDA	CURDR		;GET CURRENT DRIVE
	INR	A		;ADD 1 FOR A=1
	MOV	B,A
	LDA	CURUSR		;GET CURRENT USER
	MOV	C,A		;BC=DU
	LXI	H,PATH		;PT TO FIRST PATH ELEMENT
	JR	MPATHBC		;PLACE ENTRY INTO MPATH
	ENDIF		;SCANCUR
;
; Convert symbolic path at PATH into absolute path at MPATH
;
	LXI	H,PATH		;PT TO SYMBOLIC PATH
MPATH1:
	MOV	A,M		;CHECK FOR END OF SYMBOLIC PATH
	ORA	A		;0=END OF PATH
	JRZ	MPATH7
;
; Place absolute form for current path element in BC
;
	ANI	7FH		;MASK OUT SYSTEM BIT
	CPI	CURIND		;CHECK FOR CURRENT DRIVE
	JRNZ	MPATH2
	LDA	CURDR		;GET CURRENT DRIVE
	INR	A		;ADJUST FOR A=1
MPATH2:
	MOV	B,A		;DRIVE IN B (1=A)
	INX	H		;PT TO USER
	MOV	A,M		;GET USER
	INX	H		;PT TO NEXT ELEMENT
	ANI	7FH		;MASK OUT SYSTEM BIT
	CPI	CURIND		;CHECK FOR CURRENT USER
	JRNZ	MPATH3
	LDA	CURUSR		;GET CURRENT USER
MPATH3:
	MOV	C,A		;SET USER IN C
;
; Scan MPATH for DU element in BC
;
MPATHBC:
	PUSH	H		;SAVE PTR TO NEXT PATH ELEMENT
	LXI	H,MPATH		;PT TO MINIMUM PATH
MPATH4:
	MOV	A,M		;CHECK FOR END OF PATH
	ORA	A
	JRZ	MPATH6
	INX	H		;PT TO USER
	CMP	B		;CHECK FOR DISK MATCH
	JRNZ	MPATH5
	MOV	A,M		;GET USER
	CMP	C		;CHECK FOR USER MATCH
	JRNZ	MPATH5
	POP	H		;MATCH, SO BC IS DUPLICATE
	JR	MPATH1		;CONTINUE
MPATH5:
	INX	H		;PT TO NEXT ELEMENT
	JR	MPATH4
;
; No match, so BC is a unique DU and store it in path
;
MPATH6:
	MOV	M,B		;STORE DRIVE
	INX	H
	MOV	M,C		;STORE USER
	INX	H
	MVI	M,0		;STORE ENDING 0
	POP	H		;PT TO NEXT ENTRY
	JR	MPATH1		;CONTINUE
;
; MPATH now contains the minimal path
;
MPATH7:
;
	ENDIF		;MINPATH
;
; Non-MINPATH Processing:
;	If DRVPREFIX or SCANCUR are TRUE, look in DU in FCBDN
;
	IF	(NOT MINPATH) AND (DRVPREFIX OR SCANCUR)
	LXI	D,FCBDN		;LOOK FOR FILE
	CALL	FCBLOG		;LOG INTO FCB
	CALL	SEAR1
	JNZ	MLA4
	ENDIF		;(NOT MINPATH) AND (DRVPREFIX OR SCANCUR)
;
; Select current disk at all times
;
	XRA	A
	STA	FCBDN		;SET CURRENT DISK
MLARUN:
;
; The following selects the path to be followed; if the Minimal Path is
;   available, it is followed; else, the Symbolic Path is followed
;
	IF	MINPATH		;IF MINIMAL PATH USED
	LXI	H,MPATH		;PT TO MINIMAL PATH

	ELSE		;NOT MINPATH
	LXI	H,PATH		;PT TO SYMBOLIC PATH

	ENDIF		;MINPATH
;
; This is the main path search loop; HL pts to the next path element
;
MLA0:
	MOV	A,M		;GET DRIVE
	ORA	A		;0=DONE=COMMAND NOT FOUND
;
	IF	NOT CMDRUN	;ERROR ABORT IF NO COMMAND RUN FACILITY
	JZ	ERROR		;PATH EXHAUSTED
;
	ELSE			;CONTINUE PROCESSING FOR COMMAND RUN
;
; CMDRUN 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		;SAVE PTR TO PATH END
	ENDIF		;ROOTONLY
;
	XRA	A		;DO NOT REENTER THIS CODE
	STA	CRFLAG		;SET ZERO FOR NO ENTRY
	LXI	H,CFCB		;SET CFCB AS COMMAND
	LXI	D,FCBDN		;... BY COPYING IT INTO FCBDN
	MVI	B,12		;ONLY 12 BYTES REQUIRED
	CALL	LDIR
	LHLD	CURCMD		;GET PTR TO CURRENT COMMAND LINE
	CALL	PARSET		;PARSE AS COMMAND TAIL
;
	IF	ROOTONLY	;LOOK FOR EXT COMMAND PROCESSOR AT ROOT ONLY?
	JR	MLA3RT		;PROCESS FROM PATH END
	ELSE			;FOLLOW PATH LOOKING FOR EXT COMMAND PROCESSOR
;
	JR	MLARUN		;NOW TRY THE RUN FROM THE PATH
;
	ENDIF		;ROOTONLY
;
CFCB:
	CMDFCB			;FCB DEFINING INITIAL COMMAND
NOCRUN:
	ENDIF		;CMDRUN
;
; LOOK FOR COMMAND IN DIRECTORY PTED TO BY HL; DRIVE IN A
;
	IF	NOT MINPATH
	CPI	CURIND		;CURRENT DRIVE SPECIFIED?
	JRNZ	MLA1		;SKIP DEFAULT DRIVE SELECTION IF SO
	LDA	CURDR		;GET CURRENT DRIVE
	INR	A		;SET A=1
	ENDIF		;NOT MINPATH
;
MLA1:
	STA	TEMPDR		;SELECT DIFFERENT DRIVE IF NOT CURRENT
	INX	H		;PT TO USER NUMBER
	MOV	A,M		;GET USER NUMBER
	INX	H		;PT TO NEXT ENTRY IN PATH
	PUSH	H		;SAVE PTR
;
	IF	NOT MINPATH
	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:
	ENDIF		;NOT MINPATH
;
	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 IF 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:
	LXI	D,FCBDN		;PT TO FCB
	CALL	SEAR1		;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
	JRNZ	PRNLE		;MEMORY FULL IF NZ
;
; RETURN TO CURRENT DIRECTORY
;
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

;
; LOAD ERROR
;
PRNLE:
	CALL	PRINTC
	DB	'Ful','l'+80H
	JMP	RESTRT		;RESTART ZCPR

;*****

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

;*****

;
;  INTERNAL MINIMUM PATH
;
	IF	MINPATH
MPATH:
	DS	EXPATHS+3	;SIZE OF PATH, MAX
				;  (+2 FOR DU:COM PREFIX, +1 FOR ENDING 0)
	ENDIF		;MINPATH

;*****
	IF	EXTSTK NE 0	;EXTERNAL STACK

STACK	EQU	EXTSTK+48	;SET TOP-OF-STACK ADDRESS

	ELSE
;
;  STACK AREA
;
	DS	48		;STACK AREA
STACK	EQU	$		;TOP OF STACK
;
	ENDIF		;INTSTACK
;
	IF	PWCHECK
PWLIN	EQU	STACK-48	;PLACE LINE AT BOTTOM OF STACK
	ENDIF		;PWCHECK
;
;	The following will cause an error message to appear if
; the size of ZCPR3 is over 2K bytes.
;
	IF	($ GT CPRLOC+800H)
ZCPR3ER	EQU	NOVALUE		;ZCPR3 IS LARGER THAN 2K BYTES
	ENDIF

	END