Pegasys-RomWBW/Source/ZCPR/zcpr.asm

	TITLE	'ZCPR Version 1.0'
;
;  CP/M Z80 Command Processor Replacement (CPR) Version 1.0
;	CCPZ CREATED AND CUSTOMIZED FOR ARIES-II BY RLC
;	FURTHER MODIFIED BY RGF AS V2.0
;	FURTHER MODIFIED BY RLC AS V2.1
;	FURTHER MODIFIED BY KBP AS V2.2
;	FURTHER MODIFIED BY RLC AS V2.4 (V2.3 skipped)
;	FURTHER MODIFIED BY RLC AS V2.5
;	FURTHER MODIFIED BY RLC AS V2.6
;	FURTHUR MODIFIED BY SBB AS V2.7
;	FURTHER MODIFIED BY RLC AS V2.8
;	FURTHER MODIFIED BY RLC AS V2.9
;	FURTHER MODIFIED BY RLC AS V3.0
;	FURTHER MODIFIED BY RLC AS V3.1
;	FURTHER MODIFIED BY RLC AS V4.0
;	ZCPR VERSION 1.0 CREATED FROM CCPZ VERSION 4.0 BY RLC IN
;		A COORDINATED EFFORT WITH CCP-GROUP
;
;	ZCPR is a group effort by CCP-GROUP, whose active membership involved
; in this project consists of the following:
;		RLC - Richard Conn
;		RGF - Ron Fowler
;		KBP - Keith Peterson
;		FJW - Frank Wancho
;	The following individual also provided a contribution:
;		SBB - Steve Bogolub
;
;
;******** Structure Notes ********
;
;	This CPR 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 CPR
;
;    1		Buffers
;
;    2		CPR Starting Modules
;			CPR1	CPR	RESTRT	RSTCPR	RCPRNL
;			PRNNF
;
;    3		Utilities
;			CRLF	CONOUT	CONIN	LCOUT	LSTOUT
;			READF	READ	BDOSB	PRINTC	PRINT
;			GETDRV	DEFDMA	DMASET	RESET	BDOSJP
;			LOGIN	OPENF	OPEN	GRBDOS	CLOSE
;			SEARF	SEAR1	SEARN	SUBKIL	DELETE
;			RESETUSR GETUSR	SETUSR
;
;     4		CPR Utilities
;			SETUD	SETU0D	UCASE	REDBUF	CNVBUF
;			BREAK	USRNUM	ERROR	SDELM	ADVAN
;			SBLANK	ADDAH	NUMBER	NUMERR	HEXNUM
;			DIRPTR	SLOGIN	DLOGIN	COMLOG	SCANER
;			CMDSER
;
;     5		CPR-Resident Commands and Functions
;     5A		DIR	DIRPR	FILLQ
;     5B		ERA
;     5C		LIST
;     5D		TYPE	PAGER
;     5E		SAVE
;     5F		REN
;     5G		USER
;     5H		DFU
;     5I		JUMP
;     5J		GO
;     5K		COM	CALLPROG	ERRLOG	ERRJMP
;     5L		GET	MEMLOAD	PRNLE
;
;
FALSE	EQU	0
TRUE	EQU	NOT FALSE
;
;  CUSTOMIZATION EQUATES
;
;  The following equates may be used to customize this CPR for the user's
;    system and integration technique.  The following constants are provided:
;
;    REL - TRUE if integration is to be done via MOVCPM
;        - FALSE if integration is to be done via DDT and SYSGEN
;
;    BASE - Base Address of user's CP/M system (normally 0 for DR version)
;           This equate allows easy modification by non-standard CP/M (eg,H89)
;
;    CPRLOC - Base Page Address of CPR; this value can be obtained by running
;	      the BDOSLOC program on your system, or by setting the
;	      MSIZE and BIOSEX equates to the system memory size in
;	      K-bytes and the "extra" memory required by your BIOS
;	      in K-bytes. BIOSEX is zero if your BIOS is normal size,
;	      and can be negative if your BIOS is in PROM or in
;	      non-contiguous memory.
;
;    RAS - Remote-Access System; setting this equate to TRUE disables
;	   certain CPR commands that are considered harmful in a Remote-
;	   Access environment; use under Remote-Access Systems (RBBS) for
;	   security purposes
;
REL	EQU	FALSE	;SET TO TRUE FOR MOVCPM INTEGRATION
;
BASE	EQU	0	;BASE OF CP/M SYSTEM (SET FOR STANDARD CP/M)
;
	IF	REL
CPRLOC	EQU	0	;MOVCPM IMAGE
	ELSE
;
; If REL is FALSE, the value of CPRLOC may be set in one
; of two ways.  The first way is to set MSIZE and BIOSEX
; as described above using the following three lines:
;
;MSIZE	EQU	56	;SIZE OF MEM IN K-BYTES
;BIOSEX	EQU	0	;EXTRA # K-BYTES IN BIOS
;CPRLOC	EQU	3400H+(MSIZE-20-BIOSEX)*1024	;CPR ORIGIN
;
; The second way is to obtain the origin of your current
; CPR using BDSLOC or its equivalent, then merely set CPRLOC
; to that value as as in the following line:
;
;CPRLOC	EQU	0BD00H	;FILL IN WITH BDOSLOC SUPPLIED VALUE
CPRLOC	EQU	0D000H	;WW - CUSTOMIZED FOR ROMWBW
;
; Note that you should only use one method or the other.
; Do NOT define CPRLOC twice!
;
; The following gives the required offset to load the CPR into the
; CP/M SYSGEN Image through DDT (the Roffset command); Note that this
; value conforms with the standard value presented in the CP/M reference
; manuals, but it may not necessarily conform with the location of the
; CPR in YOUR CP/M system; several systems (Morrow Designs, P&T, Heath
; Org-0 to name a few) have the CPR located at a non-standard address in
; the SYSGEN Image
;
;CPRR	EQU	0980H-CPRLOC	;DDT LOAD OFFSET
CPRR	EQU	1100H-CPRLOC	;DDT LOAD OFFSET FOR MORROW DESIGNS
	ENDIF
;
RAS	EQU	FALSE	;SET TO TRUE IF CPR IS FOR A REMOTE-ACCESS SYSTEM
;
; The following is presented as an option, but is not generally user-customiz-
; able.  A basic design choice had to be made in the design of ZCPR concerning
; the execution of SUBMIT files.  The original CCP had a problem in this sense
; in that it ALWAYS looked for the SUBMIT file from drive A: and the SUBMIT
; program itself (SUBMIT.COM) would place the $$$.SUB file on the currently
; logged-in drive, so when the user was logged into B: and he issued a SUBMIT
; command, the $$$.SUB was placed on B: and did not execute because the CCP
; looked for it on A: and never found it.
;	After much debate it was decided to have ZCPR perform the same type of
; function as CCP (look for the $$$.SUB file on A:), but the problem with
; SUBMIT.COM still exists.  Hence, RGF designed SuperSUB and RLC took his
; SuperSUB and designed SUB from it; both programs are set up to allow the
; selection at assembly time of creating the $$$.SUB on the logged-in drive
; or on drive A:.
;	A final definition of the Indirect Command File ($$$.SUB or SUBMIT
; File) is presented as follows:
;		"An Indirect Command File is one which contains
;		 a series of commands exactly as they would be
;		 entered from a CP/M Console.  The SUBMIT Command
;		 (or SUB Command) reads this files and transforms
;		 it for processing by the ZCPR (the $$$.SUB File).
;		 ZCPR will then execute the commands indicated
;		 EXACTLY as if they were typed at the Console."
;	Hence, to permit this to happen, the $$$.SUB file must always
; be present on a specific drive, and A: is the choice for said drive.
; With this facility engaged as such, Indirect Command Files like:
;		DIR
;		A:
;		DIR
; can be executed, even though the currently logged-in drive is changed
; during execution.  If the $$$.SUB file was present on the currently
; logged-in drive, the above series of commands would not work since the
; ZCPR would be looking for $$$.SUB on the logged-in drive, and switching
; logged-in drives without moving the $$$.SUB file as well would cause
; processing to abort.
;
SUBA	equ	TRUE 	; Set to TRUE to have $$$.SUB always on A:
			; Set to FALSE to have $$$.SUB on the logged-in drive
;
;   The following flag enables extended processing for user-program supplied
; command lines.  This is for Command Level 3 of ZCPR.  Under the CCPZ Version
; 4.0 philosophy, three command levels exist:
;	(1) that command issued by the user from his console at the '>' prompt
;	(2) that command issued by a $$$.SUB file at the '$' prompt
;	(3) that command issued by a user program by placing the command into
; CIBUFF and setting the character count in CBUFF
;   Setting CLEVEL3 to TRUE enables extended processing of the third level of
; ZCPR command.  All the user program need do is to store the command line and
; set the character count; ZCPR will initialize the pointers properly, store
; the ending zero properly, and capitalize the command line for processing.
; Once the command line is properly stored, the user executes the command line
; by reentering the ZCPR through CPRLOC [NOTE:  The C register MUST contain
; a valid User/Disk Flag (see location 4) at this time.]
;
CLEVEL3	equ	TRUE		;ENABLE COMMAND LEVEL 3 PROCESSING
;
;
;*** TERMINAL AND 'TYPE' CUSTOMIZATION EQUATES
;
NLINES	EQU	24		;NUMBER OF LINES ON CRT SCREEN
WIDE	EQU	TRUE		;TRUE IF WIDE DIR DISPLAY
FENCE	EQU	'|'		;SEP CHAR BETWEEN DIR FILES
;
PGDFLT	EQU	TRUE  		;SET TO FALSE TO DISABLE PAGING BY DEFAULT
PGDFLG	EQU	'P'		;FOR TYPE COMMAND: PAGE OR NOT (DEP ON PGDFLT)
				;  THIS FLAG REVERSES THE DEFAULT EFFECT
;
MAXUSR	EQU	15 		;MAXIMUM USER NUMBER ACCESSABLE
;
SYSFLG	EQU	'A' 		;FOR DIR COMMAND: LIST $SYS AND $DIR
;
SOFLG	EQU	'S'		;FOR DIR COMMAND: LIST $SYS FILES ONLY
;
SUPRES	EQU	TRUE 		;SUPRESSES USER # REPORT FOR USER 0
;
DEFUSR	EQU	0 		;DEFAULT USER NUMBER FOR COM FILES
;
SPRMPT	EQU	'$'		;CPR PROMPT INDICATING SUBMIT COMMAND
CPRMPT	EQU	'>'		;CPR PROMPT INDICATING USER COMMAND
;
NUMBASE	EQU	'H'		;CHARACTER USED TO SWITCH FROM DEFAULT
				; NUMBER BASE
;
SECTFLG	EQU	'S'		;OPTION CHAR FOR SAVE COMMAND TO SAVE SECTORS
;
; END OF CUSTOMIZATION SECTION
;
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
;
;
;
;	@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
	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
;
; END OF Z80 MACRO EXTENSIONS
;
;
;**** Section 0 ****
;
	ORG	CPRLOC
;
;  ENTRY POINTS INTO ZCPR
;    If the ZCPR is entered at location CPRLOC (at the JMP to CPR), then
; the default command in CIBUFF will be processed.  If the ZCPR is entered
; at location CPRLOC+3 (at the JMP to CPR1), then the default command in
; CIBUFF will NOT be processed.
;    NOTE:  Entry into ZCPR in this way is permitted under ZCPR Version 4.0,
; but in order for this to work, CIBUFF and CBUFF MUST be initialized properly
; AND the C register MUST contain a valid User/Disk Flag (see Location 4: 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.  Under Version 4.x of ZCPR, this is
; no longer the case.  The CIBPTR (Command Input Buffer PoinTeR) is located
; to be compatable with such programs (provided they determine the buffer
; length from the byte at MBUFF [CPRLOC + 6]), but under Version 4.x of ZCPR
; this is no longer necessary.  ZCPR Version 4.x automatically initializes
; this buffer pointer in all cases.
;
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
; CIBUFF.  This command line is terminated by the last character (NOT Carriage
; Return), and a character count of all characters in the command line
; up to and including the last character is placed into location CBUFF
; (immediately before the command line at CIBUFF).  The placed command line
; is then parsed, interpreted, and the indicated command is executed.
; If CLEVEL3 is permitted, a terminating zero is placed after the command
; (otherwise the user program has to place this zero) and the CIBPTR is
; properly initialized (otherwise the user program has to init this ptr).
; If the command is placed by a user program, entering at CPRLOC is enough
; to have the command processed.  Again, under CCPZ Version 4.0, it is not
; necessary to store the pointer to CIBUFF in CIBPTR; ZCPR will do this for
; the calling program if CLEVEL3 is made TRUE.
;   WARNING:  The command line must NOT exceed BUFLEN characters in length.
; For user programs which load this command, the value of BUFLEN can be
; obtained by examining the byte at MBUFF (CPRLOC + 6).
;
BUFLEN	EQU	80		;MAXIMUM BUFFER LENGTH
MBUFF:
	DB	BUFLEN		;MAXIMUM BUFFER LENGTH
CBUFF:
	DB	0		;NUMBER OF VALID CHARS IN COMMAND LINE
CIBUFF:
	DB	'               '	;DEFAULT (COLD BOOT) COMMAND
CIBUF:
	DB	0			;COMMAND STRING TERMINATOR
	DS	BUFLEN-($-CIBUFF)+1	;TOTAL IS 'BUFLEN' BYTES
;
CIBPTR:
	DW	CIBUFF		;POINTER TO COMMAND INPUT BUFFER
CIPTR:
	DW	CIBUF		;CURRENT POINTER
;
	DS	26		;STACK AREA
STACK	EQU	$		;TOP OF STACK
;
; FILE TYPE FOR COMMAND
;
COMMSG:
	DB	'COM'
;
; SUBMIT FILE CONTROL BLOCK
;
SUBFCB:
	IF	SUBA		;IF $$$.SUB ON A:
	DB	1		;DISK NAME SET TO DEFAULT TO DRIVE A:
	ENDIF
;
	IF	NOT SUBA	;IF $$$.SUB ON CURRENT DRIVE
	DB	0		;DISK NAME SET TO DEFAULT TO CURRENT DRIVE
	ENDIF
;
	DB	'$$$'		;FILE NAME
	DB	'     '
	DB	'SUB'		;FILE TYPE
	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
;
; COMMAND FILE CONTROL BLOCK
;
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
;
; OTHER BUFFERS
;
PAGCNT:
	DB	NLINES-2	;LINES LEFT ON PAGE
CHRCNT:
	DB	0		;CHAR COUNT FOR TYPE
QMCNT:
	DB	0		;QUESTION MARK COUNT FOR FCB TOKEN SCANNER
;
; CPR BUILT-IN COMMAND TABLE
;
NCHARS	EQU	4		;NUMBER OF CHARS/COMMAND
;
; CPR COMMAND NAME TABLE
;   EACH TABLE ENTRY IS COMPOSED OF THE 4-BYTE COMMAND AND 2-BYTE ADDRESS
;
CMDTBL:
	DB	'DIR '
	DW	DIR
	DB	'LIST'
	DW	LIST
	DB	'TYPE'
	DW	TYPE
	DB	'USER'
	DW	USER
	DB	'DFU '
	DW	DFU
;
	IF	NOT RAS		;FOR NON-RAS
	DB	'GO  '
	DW	GO
	DB	'ERA '
	DW	ERA
	DB	'SAVE'
	DW	SAVE
	DB	'REN '
	DW	REN
	DB	'GET '
	DW	GET
	DB	'JUMP'
	DW	JUMP
	ENDIF
;
NCMNDS	EQU	($-CMDTBL)/(NCHARS+2)
;
;
;**** Section 2 ****
; CPR STARTING POINTS
;
; START CPR AND DON'T PROCESS DEFAULT COMMAND STORED
;
CPR1:
	XRA	A		;SET NO DEFAULT COMMAND
	STA	CBUFF
;
; START CPR AND POSSIBLY PROCESS DEFAULT COMMAND
;
; NOTE ON MODIFICATION BY RGF: 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
	PUSH	B
	MOV	A,C		;C=USER/DISK NUMBER (SEE LOC 4)
	RAR			;EXTRACT USER NUMBER
	RAR
	RAR
	RAR
	ANI	0FH
	MOV	E,A		;SET USER NUMBER
	CALL	SETUSR
	CALL	RESET		;RESET DISK SYSTEM
	STA	RNGSUB		;SAVE SUBMIT CLUE FROM DRIVE A:
	POP	B
	MOV	A,C		;C=USER/DISK NUMBER (SEE LOC 4)
	ANI	0FH		;EXTRACT DEFAULT DISK DRIVE
	STA	TDRIVE		;SET IT
	JRZ	NOLOG		;SKIP IF 0...ALREADY LOGGED
	CALL	LOGIN		;LOG IN DEFAULT DISK
;
	IF	NOT SUBA	;IF $$$.SUB IS ON CURRENT DRIVE
	STA	RNGSUB		;BDOS '$' CLUE
	ENDIF
;
NOLOG:
	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
	CMA			;PREPARE FOR COMING 'CMA'
	CNZ	SEAR1
	CMA			;0FFH IS RETURNED IF NO $$$.SUB, SO COMPLEMENT
	STA	RNGSUB		;SET FLAG (0=NO $$$.SUB)
	LDA	CBUFF		;EXECUTE DEFAULT COMMAND?
	ORA	A		;0=NO
	JRNZ	RS1
;
; PROMPT USER AND INPUT COMMAND LINE FROM HIM
;
RESTRT:
	LXI	SP,STACK	;RESET STACK
;
; PRINT PROMPT (DU>)
;
	CALL	CRLF		;PRINT PROMPT
	CALL	GETDRV		;CURRENT DRIVE IS PART OF PROMPT
	ADI	'A'		;CONVERT TO ASCII A-P
	CALL	CONOUT
	CALL	GETUSR		;GET USER NUMBER
;
	IF	SUPRES		;IF SUPPRESSING USR # REPORT FOR USR 0
	ORA	A
	JRZ	RS000
	ENDIF
;
	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
;
; READ INPUT LINE FROM USER OR $$$.SUB
;
RS000:
	CALL	REDBUF		;INPUT COMMAND LINE FROM USER (OR $$$.SUB)
;
; PROCESS INPUT LINE
;
RS1:
;
	IF	CLEVEL3		;IF THIRD COMMAND LEVEL IS PERMITTED
	CALL	CNVBUF		;CAPITALIZE COMMAND LINE, PLACE ENDING 0,
				; AND SET CIBPTR VALUE
	ENDIF
;
	CALL	DEFDMA		;SET TBUFF TO DMA ADDRESS
	CALL	GETDRV		;GET DEFAULT DRIVE NUMBER
	STA	TDRIVE		;SET IT
	CALL	SCANER		;PARSE COMMAND NAME FROM COMMAND LINE
	CNZ	ERROR		;ERROR IF COMMAND NAME CONTAINS A '?'
	LXI	D,RSTCPR	;PUT RETURN ADDRESS OF COMMAND
	PUSH	D		;ON THE STACK
	LDA	TEMPDR		;IS COMMAND OF FORM 'D:COMMAND'?
	ORA	A		;NZ=YES
	JNZ	COM		; IMMEDIATELY
	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 DEFAULT DRIVE
;
; 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
	SUI	' '		;ANY CHAR?
	LXI	H,TEMPDR
	ORA	M
	JNZ	ERROR
	JR	RESTRT
;
; 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	;FALL THRU TO CONOUT
;
CONOUT:
	PUSH	B
	MVI	C,02H
OUTPUT:
	MOV	E,A
	PUSH	H
	CALL	BDOS
	POP	H
	POP	B
	RET
;
CONIN:
	MVI	C,01H	;GET CHAR FROM CON: WITH ECHO
	CALL	BDOSB
	JMP	UCASE	;CAPITALIZE
;
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:
	PUSH	B
	MVI	C,05H
	JR	OUTPUT
LC1:
	POP	PSW	;GET CHAR
	PUSH	PSW
	CALL	CONOUT	;OUTPUT TO CON:
	POP	PSW
	CPI	LF	;CHECK FOR PAGING
	JZ	PAGER
	RET
;
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 0) PTED TO BY RET ADR;START WITH <CRLF>
;
PRINTC:
	PUSH	PSW		;SAVE FLAGS
	CALL	CRLF		;NEW LINE
	POP	PSW
;
PRINT:
	XTHL			;GET PTR TO STRING
	PUSH	PSW		;SAVE FLAGS
	CALL	PRIN1		;PRINT STRING
	POP	PSW		;GET FLAGS
	XTHL			;RESTORE HL AND RET ADR
	RET
;
; PRINT STRING (ENDING IN 0) PTED TO BY HL
;
PRIN1:
	MOV	A,M		;GET NEXT BYTE
	ORA	A		;WW - SET FLAGS
	RZ			;WW - DONE IF ZERO
	ANI	7FH		;WW - CLEAR HIGH BIT
	CALL	CONOUT		;PRINT CHAR
	MOV	A,M		;GET NEXT BYTE AGAIN FOR TEST
	INX	H		;PT TO NEXT BYTE
	ORA	A		;SET FLAGS
	RM			;DONE IF 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
;
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
;
DELETE:
	MVI	C,13H
	JR	BDOSJP	;SAVE MORE SPACE
;
; RESET USER NUMBER IF CHANGED
;
RESETUSR:
TMPUSR	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;2ND BYTE (IMMEDIATE ARG) IS TMPUSR
	MOV	E,A		;PLACE IN E
	JR	SETUSR		;THEN GO SET USER
GETUSR:
	MVI	E,0FFH		;GET CURRENT USER NUMBER
SETUSR:
	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 ****
; CPR UTILITIES
;
; SET USER/DISK FLAG TO CURRENT USER AND DEFAULT DISK
;
SETUD:
	CALL	GETUSR		;GET NUMBER OF CURRENT USER
	ADD	A		;PLACE IT IN HIGH NYBBLE
	ADD	A
	ADD	A
	ADD	A
	LXI	H,TDRIVE	;MASK IN DEFAULT DRIVE NUMBER (LOW NYBBLE)
	ORA	M		;MASK IN
	STA	UDFLAG		;SET USER/DISK NUMBER
	RET
;
; SET USER/DISK FLAG TO USER 0 AND DEFAULT DISK
;
SETU0D:
TDRIVE	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;2ND BYTE (IMMEDIATE ARG) IS TDRIVE
	STA	UDFLAG		;SET USER/DISK NUMBER
	RET
;
; CONVERT CHAR IN A TO UPPER CASE
;
UCASE:
	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:
	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,CBUFF 	;COPY LAST RECORD (NEXT SUBMIT CMND) TO CBUFF
	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,CIBUFF	;PRINT COMMAND LINE FROM $$$.SUB
	CALL	PRIN1
	CALL	BREAK		;CHECK FOR ABORT (ANY CHAR)
;
	IF	CLEVEL3		;IF THIRD COMMAND LEVEL IS PERMITTED
	RZ			;IF <NULL> (NO ABORT), RETURN TO CALLER AND RUN
	ENDIF
;
	IF	NOT CLEVEL3	;IF THIRD COMMAND LEVEL IS NOT PERMITTED
	JRZ	CNVBUF		;IF <NULL> (NO ABORT), CAPITALIZE COMMAND
	ENDIF
;
	CALL	SUBKIL		;KILL $$$.SUB IF ABORT
	JMP	RESTRT		;RESTART CPR
;
; INPUT COMMAND LINE FROM USER CONSOLE
;
RB1:
	CALL	SUBKIL		;ERASE $$$.SUB IF PRESENT
	CALL	SETUD		;SET USER AND DISK
	MVI	A,CPRMPT	;PRINT PROMPT
	CALL	CONOUT
	MVI	C,0AH		;READ COMMAND LINE FROM USER
	LXI	D,MBUFF
	CALL	BDOS
;
	IF	CLEVEL3		;IF THIRD COMMAND LEVEL IS PERMITTED
	JMP	SETU0D		;SET CURRENT DISK NUMBER IN LOWER PARAMS
	ENDIF
;
	IF	NOT CLEVEL3	;IF THIRD COMMAND LEVEL IS NOT PERMITTED
	CALL	SETU0D		;SET CURRENT DISK NUMBER IF LOWER PARAMS
				; AND FALL THRU TO CNVBUF
	ENDIF
;
; CAPITALIZE STRING (ENDING IN 0) IN CBUFF AND SET PTR FOR PARSING
;
CNVBUF:
	LXI	H,CBUFF 	;PT TO USER'S COMMAND
	MOV	B,M		;CHAR COUNT IN B
	INR	B		;ADD 1 IN CASE OF ZERO
CB1:
	INX	H		;PT TO 1ST VALID CHAR
	MOV	A,M		;CAPITALIZE COMMAND CHAR
	CALL	UCASE
	MOV	M,A
	DJNZ	CB1		;CONTINUE TO END OF COMMAND LINE
CB2:
	MVI	M,0		;STORE ENDING <NULL>
	LXI	H,CIBUFF	;SET COMMAND LINE PTR TO 1ST CHAR
	SHLD	CIBPTR
	RET
;
; CHECK FOR ANY CHAR FROM USER CONSOLE;RET W/ZERO SET IF NONE
;
BREAK:
	PUSH	D		;SAVE DE
	MVI	C,11		;CSTS CHECK
	CALL	BDOSB
	CNZ	CONIN		;GET INPUT CHAR
BRKBK:
	POP	D
	RET
;
; GET THE REQUESTED USER NUMBER FROM THE COMMAND LINE AND VALIDATE IT.
;
USRNUM:
	CALL	NUMBER
	CPI	MAXUSR+1
	RC
;
; INVALID COMMAND -- PRINT IT
;
ERROR:
	CALL	CRLF		;NEW LINE
	LHLD	CIPTR		;PT TO BEGINNING OF COMMAND LINE
ERR2:
	MOV	A,M		;GET CHAR
	CPI	' '+1		;SIMPLE '?' IF <SP> OR LESS
	JRC	ERR1
	PUSH	H		;SAVE PTR TO ERROR COMMAND CHAR
	CALL	CONOUT		;PRINT COMMAND CHAR
	POP	H		;GET PTR
	INX	H		;PT TO NEXT
	JR	ERR2		;CONTINUE
ERR1:
	CALL	PRINT		;PRINT '?'
	DB	'?'+80H
	CALL	SUBKIL		;TERMINATE ACTIVE $$$.SUB IF ANY
	JMP	RESTRT		;RESTART CPR
;
; CHECK TO SEE IF DE PTS TO DELIMITER; IF SO, RET W/ZERO FLAG SET
;
SDELM:
	LDAX	D
	ORA	A		;0=DELIMITER
	RZ
	CPI	' '		;ERROR IF < <SP>
	JRC	ERROR
	RZ			;<SP>=DELIMITER
	CPI	'='		;'='=DELIMITER
	RZ
	CPI	5FH		;UNDERSCORE=DELIMITER
	RZ
	CPI	'.'		;'.'=DELIMITER
	RZ
	CPI	':'		;':'=DELIMITER
	RZ
	CPI	';'		;';'=DELIMITER
	RZ
	CPI	'<'		;'<'=DELIMITER
	RZ
	CPI	'>'		;'>'=DELIMITER
	RET
;
; ADVANCE INPUT PTR TO FIRST NON-BLANK AND FALL THROUGH TO SBLANK
;
ADVAN:
	LDED	CIBPTR
;
; SKIP STRING PTED TO BY DE (STRING ENDS IN 0) UNTIL END OF STRING
;   OR NON-BLANK ENCOUNTERED (BEGINNING OF TOKEN)
;
SBLANK:
	LDAX	D
	ORA	A
	RZ
	CPI	' '
	RNZ
	INX	D
	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
	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
	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
	RLC
	RLC
	ADD	C		;CHECK FOR RANGE ERROR
	JRC	NUMERR
	ADD	C		;CHECK FOR RANGE ERROR
	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 IF NOT DEFAULT
;
SLOGIN:
	XRA	A		;SET FCBDN FOR DEFAULT DRIVE
	STA	FCBDN
	CALL	COMLOG		;CHECK DRIVE
	RZ
	JR	DLOG5		;DO LOGIN OTHERWISE
;
; CHECK FOR SPECIFIED DRIVE AND LOG IN DEFAULT DRIVE IF SPECIFIED<>DEFAULT
;
DLOGIN:
	CALL	COMLOG		;CHECK DRIVE
	RZ			;ABORT IF SAME
	LDA	TDRIVE		;LOG IN DEFAULT DRIVE
;
DLOG5:	JMP	LOGIN
;
; ROUTINE COMMON TO BOTH LOGIN ROUTINES; ON EXIT, Z SET MEANS ABORT
;
COMLOG:
TEMPDR	EQU	$+1		;POINTER FOR IN-THE-CODE MODIFICATION
	MVI	A,0		;2ND BYTE (IMMEDIATE ARG) IS TEMPDR
	ORA	A		;0=NO
	RZ
	DCR	A		;COMPARE IT AGAINST DEFAULT
	LXI	H,TDRIVE
	CMP	M
	RET			;ABORT IF SAME
;
; EXTRACT TOKEN FROM COMMAND LINE AND PLACE IT INTO FCBDN;
;   FORMAT FCBDN FCB IF TOKEN RESEMBLES FILE NAME AND TYPE (FILENAME.TYP);
;   ON INPUT, CIBPTR PTS TO CHAR AT WHICH TO START SCAN;
;   ON OUTPUT, CIBPTR PTS TO CHAR AT WHICH TO CONTINUE AND ZERO FLAG IS RESET
;     IF '?' IS IN TOKEN
;
; ENTRY POINTS:
;	SCANER - LOAD TOKEN INTO FIRST FCB
;	SCANX - LOAD TOKEN INTO FCB PTED TO BY HL
;
SCANER:
	LXI	H,FCBDN 	;POINT TO FCBDN
SCANX:
	XRA	A		;SET TEMPORARY DRIVE NUMBER TO DEFAULT
	STA	TEMPDR
	CALL	ADVAN		;SKIP TO NON-BLANK OR END OF LINE
	SDED	CIPTR		;SET PTR TO NON-BLANK OR END OF LINE
	LDAX	D		;END OF LINE?
	ORA	A		;0=YES
	JRZ	SCAN2
	SBI	'A'-1		;CONVERT POSSIBLE DRIVE SPEC TO NUMBER
	MOV	B,A		;STORE NUMBER (A:=0, B:=1, ETC) IN B
	INX	D		;PT TO NEXT CHAR
	LDAX	D		;SEE IF IT IS A COLON (:)
	CPI	':'
	JRZ	SCAN3		;YES, WE HAVE A DRIVE SPEC
	DCX	D		;NO, BACK UP PTR TO FIRST NON-BLANK CHAR
SCAN2:
	LDA	TDRIVE		;SET 1ST BYTE OF FCBDN AS DEFAULT DRIVE
	MOV	M,A
	JR	SCAN4
SCAN3:
	MOV	A,B		;WE HAVE A DRIVE SPEC
	STA	TEMPDR		;SET TEMPORARY DRIVE
	MOV	M,B		;SET 1ST BYTE OF FCBDN AS SPECIFIED DRIVE
	INX	D		;PT TO BYTE AFTER ':'
;
; EXTRACT FILENAME FROM POSSIBLE FILENAME.TYP
;
SCAN4:
	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
	CPI	'.'		;IF (DE) DELIMITER IS A '.', WE HAVE A TYPE
	JRNZ	SCAN15		;FILL FILE TYPE BYTES WITH <SP>
	INX	D		;PT TO CHAR IN COMMAND LINE AFTER '.'
	CALL	SCANF		;FILL FCB FILE TYPE
	JR	SCAN16		;SKIP TO NEXT PROCESSING
SCAN15:
	CALL	SCANF4		;SPACE FILL
;
; FILL IN EX, S1, S2, AND RC WITH ZEROES
;
SCAN16:
	MVI	B,4		;4 BYTES
SCAN17:
	INX	H		;PT TO NEXT BYTE IN FCBDN
	MVI	M,0
	DJNZ	SCAN17
;
; SCAN COMPLETE -- DE PTS TO DELIMITER BYTE AFTER TOKEN
;
	SDED	CIBPTR
;
; SET ZERO FLAG TO INDICATE PRESENCE OF '?' IN FILENAME.TYP
;
	LDA	QMCNT		;GET 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 FCBDN AND DON'T ADVANCE DE IF SO
	CALL	SCQ		;SCANNER COUNT QUESTION MARKS
	JR	SCANF2
SCANF1:
	MOV	M,A		;STORE FILENAME CHAR IN FCBDN
	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:
	INX	H		;PT TO NEXT BYTE IN FCBDN
	MVI	M,' '		;FILL FILENAME PART WITH <SP>
	DJNZ	SCANF4
	RET
;
;  INCREMENT QUESTION MARK COUNT FOR SCANNER
;    THIS ROUTINE INCREMENTS THE COUNT OF THE NUMBER OF QUESTION MARKS IN
;    THE CURRENT FCB ENTRY
;
SCQ:
	LDA	QMCNT		;GET COUNT
	INR	A		;INCREMENT
	STA	QMCNT		;PUT COUNT
	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
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
	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
;
DIR:
	MVI	A,80H		;SET SYSTEM BIT EXAMINATION
	PUSH	PSW
	CALL	SCANER		;EXTRACT POSSIBLE D:FILENAME.TYP TOKEN
	CALL	SLOGIN		;LOG IN DRIVE IF NECESSARY
	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,0		;SYS TOKEN DEFAULT
	JRZ	DIR2		;JUMP; THERE ISN'T ONE
	CPI	SYSFLG		;SYSTEM FLAG SPECIFIER?
	JRZ	GOTSYS		;GOT SYSTEM SPECIFIER
	CPI	SOFLG		;SYS ONLY?
	JRNZ	DIR2
	MVI	B,80H		;FLAG SYS ONLY
GOTSYS:
	INX	D
	SDED	CIBPTR
	CPI	SOFLG		;SYS ONLY SPEC?
	JRZ	DIR2		;THEN LEAVE BIT SPEC UNCHAGNED
	POP	PSW		;GET FLAG
	XRA	A		;SET NO SYSTEM BIT EXAMINATION
	PUSH	PSW 
DIR2:
	POP	PSW		;GET FLAG
DIR2A:
				;DROP INTO DIRPR TO PRINT DIRECTORY
				; THEN RESTART CPR
;
; DIRECTORY PRINT ROUTINE; ON ENTRY, MSB OF A IS 1 (80H) IF SYSTEM FILES EXCL
;
DIRPR:
	MOV	D,A		;STORE SYSTEM FLAG IN D
	MVI	E,0		;SET COLUMN COUNTER TO ZERO
	PUSH	D		;SAVE COLUMN COUNTER (E) AND SYSTEM FLAG (D)
	MOV	A,B		;SYS ONLY SPECIFIER
	STA	SYSTST
	CALL	SEARF		;SEARCH FOR SPECIFIED FILE (FIRST OCCURRANCE)
	CZ	PRNNF		;PRINT NO FILE MSG;REG A NOT CHANGED
;
; ENTRY SELECTION LOOP; ON ENTRY, A=OFFSET FROM SEARF OR SEARN
;
DIR3:
	JRZ	DIR11		;DONE IF ZERO FLAG SET
	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
	POP	D		;GET SYSTEM BIT MASK FROM D
	PUSH	D
	ANA	D		;MASK FOR SYSTEM BIT
SYSTST	EQU	$+1		;POINTER TO IN-THE-CODE BUFFER SYSTST
	CPI	0
	JRNZ	DIR10
	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
	PUSH	PSW
	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
	ENDIF
;
	IF	NOT WIDE
	DB	' '		;SPACE
	DB	FENCE		;THEN FENCE CHAR
	DB	' '+80H		;THEN SPACE
	ENDIF
;
DIR5:
	MVI	B,01H		;PT TO 1ST BYTE OF FILE NAME
DIR6:
	MOV	A,B		;A=OFFSET
	CALL	DIRPTR		;HL NOW PTS TO 1ST BYTE OF FILE NAME
	ANI	7FH		;MASK OUT MSB
	CPI	' '		;NO FILE NAME?
	JRNZ	DIR8		;PRINT FILE NAME IF PRESENT
	POP	PSW
	PUSH	PSW
	CPI	03H
	JRNZ	DIR7
	MVI	A,09H		;PT TO 1ST BYTE OF FILE TYPE
	CALL	DIRPTR		;HL NOW PTS TO 1ST BYTE OF FILE TYPE
	ANI	7FH		;MASK OUT MSB
	CPI	' '		;NO FILE TYPE?
	JRZ	DIR9		;CONTINUE IF SO
DIR7:
	MVI	A,' '		;OUTPUT <SP>
DIR8:
	CALL	CONOUT		;PRINT CHAR
	INR	B		;INCR CHAR COUNT
	MOV	A,B
	CPI	12		;END OF FILENAME.TYP?
	JRNC	DIR9		;CONTINUE IF SO
	CPI	09H		;END IF FILENAME ONLY?
	JRNZ	DIR6		;PRINT TYP IF SO
	MVI	A,'.'		;PRINT DOT BETWEEN FILE NAME AND TYPE
	CALL	CONOUT
	JR	DIR6
DIR9:
	POP	PSW
DIR10:
	CALL	BREAK		;CHECK FOR ABORT
	JRNZ	DIR11
	CALL	SEARN		;SEARCH FOR NEXT FILE
	JR	DIR3		;CONTINUE
DIR11:
	POP	D		;RESTORE STACK
	RET
;
; 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
;
	IF	NOT RAS		;NOT FOR REMOTE-ACCESS SYSTEM
;
ERA:
	CALL	SCANER		;PARSE FILE SPECIFICATION
	CPI	11		;ALL WILD (ALL FILES = 11 '?')?
	JRNZ	ERA1		;IF NOT, THEN DO ERASES
	CALL	PRINTC
	DB	'All','?'+80H
	CALL	CONIN		;GET REPLY
	CPI	'Y'		;YES?
	JNZ	RESTRT		;RESTART CPR IF NOT
	CALL	CRLF		;NEW LINE
ERA1:
	CALL	SLOGIN		;LOG IN SELECTED DISK IF ANY
	XRA	A		;PRINT ALL FILES (EXAMINE SYSTEM BIT)
	MOV	B,A		;NO SYS-ONLY OPT TO DIRPR
	CALL	DIRPR		;PRINT DIRECTORY OF ERASED FILES
	LXI	D,FCBDN 	;DELETE FILE SPECIFIED
	CALL	DELETE
	RET			;REENTER CPR
;
	ENDIF			;RAS
;
;Section 5C
;Command: LIST
;Function:  Print out specified file on the LST: Device
;Forms:
;	LIST <ufn>	Print file (NO Paging)
;
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	
;
TYPE:
	XRA	A		;TURN OFF PRINTER FLAG
;
; ENTRY POINT FOR CPR LIST FUNCTION (LIST)
;
TYPE0:
	STA	PRFLG		;SET FLAG
	CALL	SCANER		;EXTRACT FILENAME.TYP TOKEN
	JNZ	ERROR		;ERROR IF ANY QUESTION MARKS
	CALL	ADVAN		;GET PGDFLG IF IT'S THERE
	STA	PGFLG		;SAVE IT AS A FLAG
	JRZ	NOSLAS		;JUMP IF INPUT ENDED
	INX	D		;PUT NEW BUF POINTER
	XCHG
	SHLD	CIBPTR
NOSLAS:
	CALL	SLOGIN		;LOG IN SELECTED DISK IF ANY
	CALL	OPENF		;OPEN SELECTED FILE
	JZ	TYPE4		;ABORT IF ERROR
	CALL	CRLF		;NEW LINE
	MVI	A,NLINES-1	;SET LINE COUNT
	STA	PAGCNT
	LXI	H,CHRCNT	;SET CHAR POSITION/COUNT
	MVI	M,0FFH		;EMPTY LINE
	MVI	B,0		;SET TAB CHAR COUNTER
TYPE1:
	LXI	H,CHRCNT	;PT TO CHAR POSITION/COUNT
	MOV	A,M		;END OF BUFFER?
	CPI	80H
	JRC	TYPE2
	PUSH	H		;READ NEXT BLOCK
	CALL	READF
	POP	H
	JRNZ	TYPE3		;ERROR?
	XRA	A		;RESET COUNT
	MOV	M,A
TYPE2:
	INR	M		;INCREMENT CHAR COUNT
	LXI	H,TBUFF 	;PT TO BUFFER
	CALL	ADDAH		;COMPUTE ADDRESS OF NEXT CHAR FROM OFFSET
	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	TABRST
	CPI	LF		;RESET TAB COUNT?
	JRZ	TABRST
	CPI	TAB		;TAB?
	JRZ	LTAB
	CALL	LCOUT		;OUTPUT CHAR
	INR	B		;INCREMENT CHAR COUNT
	JR	TYPE2L
TABRST:
	CALL	LCOUT		;OUTPUT <CR> OR <LF>
	MVI	B,0		;RESET TAB COUNTER
	JR	TYPE2L
LTAB:
	MVI	A,' '		;<SP>
	CALL	LCOUT
	INR	B		;INCR POS COUNT
	MOV	A,B
	ANI	7
	JRNZ	LTAB
;
; CONTINUE PROCESSING
;
TYPE2L:
	CALL	BREAK		;CHECK FOR ABORT
	JRZ	TYPE1		;CONTINUE IF NO CHAR
	CPI	'C'-'@' 	;^C?
	RZ			;RESTART IF SO
	JR	TYPE1
TYPE3:
	DCR	A		;NO ERROR?
	RZ			;RESTART CPR
TYPE4:
	JMP	ERRLOG
;
; 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	PGBAK		;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	PGBAK		;  PGDFLG MEANS NO PAGING, PLEASE
	ELSE			;IF PAGING NOT DEFAULT
	JRNZ	PGBAK		;  PGDFLG MEANS PLEASE PAGINATE
	ENDIF
;
	CALL	CONIN		;GET CHAR TO CONTINUE
	CPI	'C'-'@' 	;^C
	JZ	RSTCPR		;RESTART CPR
PGBAK:
	POP	H		;RESTORE HL
	RET
;
;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
;
	IF	NOT RAS		;NOT FOR REMOTE-ACCESS SYSTEM
;
SAVE:
	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	CIBPTR		;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:
	CALL	DEFDMA		;SET DMA TO 0080
	RET			;RESTART CPR
;
; Test File in FCB for existence, ask user to delete if so, and abort if he
;  choses not to
;
EXTEST:
	CALL	SCANER		;EXTRACT FILE NAME
	JNZ	ERROR		;'?' IS NOT PERMITTED
	CALL	SLOGIN		;LOG IN SELECTED DISK
	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	'Delete File','?'+80H
	CALL	CONIN		;GET RESPONSE
	POP	D		;GET PTR TO FCB
	CPI	'Y'		;KEY ON YES
	JNZ	RSTCPR		;RESTART IF NO
	PUSH	D		;SAVE PTR TO FCB
	CALL	DELETE		;DELETE FILE
	POP	D		;GET PTR TO FCB
	RET
;
	ENDIF			;RAS
;
;Section 5F
;Command: REN
;Function:  To change the name of an existing file
;Forms:
;	REN <New ufn>=<Old ufn>	Perform function
;
	IF	NOT RAS		;NOT FOR REMOTE-ACCESS SYSTEM
;
REN:
	CALL	EXTEST		;TEST FOR FILE EXISTENCE AND RETURN
				; IF FILE DOESN'T EXIST; ABORT IF IT DOES
	LDA	TEMPDR		;SAVE CURRENT DEFAULT 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 CIBPTR
	CPI	'='		;'=' OK
	JRNZ	REN4
REN1:
	XCHG			;PT TO CHAR AFTER '=' IN HL
	INX	H
	SHLD	CIBPTR		;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 CURRENT DEFAULT DRIVE
	MOV	A,M		;MATCH?
	ORA	A
	JRZ	REN2
	CMP	B		;CHECK FOR DRIVE ERROR
	MOV	M,B
	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	ERRLOG
;
	ENDIF			;RAS
;
;Section 5G
;Command: USER
;Function:  Change current USER number
;Forms:
;	USER <unum>	Select specified user number;<unum> is in DEC
;
USER:
	CALL	USRNUM		;EXTRACT USER NUMBER FROM COMMAND LINE
	MOV	E,A		;PLACE USER NUMBER IN E
	CALL	SETUSR		;SET SPECIFIED USER
RSTJMP:
	JMP	RCPRNL		;RESTART CPR
;
;Section 5H
;Command: DFU
;Function:  Set the Default User Number for the command/file scanner
;	     (MEMLOAD)
;Forms:
;	DFU <unum>	Select Default User Number;<unum> is in DEC
;
DFU:
	CALL	USRNUM		;GET USER NUMBER
	STA	DFUSR		;PUT IT AWAY
	JR	RSTJMP		;RESTART CPR (NO DEFAULT LOGIN)
;
;Section 5I
;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	NOT RAS		;NOT FOR REMOTE-ACCESS SYSTEM
;
JUMP:
	CALL	HEXNUM		;GET LOAD ADDRESS IN HL
	JR	CALLPROG	;PERFORM CALL
;
	ENDIF			;RAS
;
;Section 5J
;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	NOT RAS		;ONLY IF RAS
;
GO:	LXI	H,TPA		;Always to TPA
	JR	CALLPROG	;Perform call
;
	ENDIF			;END OF GO FOR RAS
;
;Section 5K
;Command: COM file processing
;Function:  To load the specified COM file from disk and execute it
;Forms:
;	<command>
;
COM:
	LDA	FCBFN		;ANY COMMAND?
	CPI	' '		;' ' MEANS COMMAND WAS 'D:' TO SWITCH
	JRNZ	COM1		;NOT <SP>, SO MUST BE TRANSIENT OR ERROR
	LDA	TEMPDR		;LOOK FOR DRIVE SPEC
	ORA	A		;IF ZERO, JUST BLANK
	JZ	RCPRNL
	DCR	A		;ADJUST FOR LOG IN
	STA	TDRIVE		;SET DEFAULT DRIVE
	CALL	SETU0D		;SET DRIVE WITH USER 0
	CALL	LOGIN		;LOG IN DRIVE
	JMP	RCPRNL		;RESTART CPR
COM1:
	LDA	FCBFT		;FILE TYPE MUST BE BLANK
	CPI	' '
	JNZ	ERROR
	LXI	H,COMMSG	;PLACE DEFAULT FILE TYPE (COM) INTO FCB
	LXI	D,FCBFT		;COPY INTO FILE TYPE
	LXI	B,3		;3 BYTES
	LDIR
	LXI	H,TPA		;SET EXECUTION/LOAD ADDRESS
	PUSH	H		;SAVE FOR EXECUTION
	CALL	MEMLOAD		;LOAD MEMORY WITH FILE SPECIFIED IN CMD LINE
	POP	H		;GET EXECUTION ADDRESS
	RNZ			;RETURN (ABORT) IF LOAD ERROR
;
; 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	DLOGIN		;LOG IN DEFAULT DRIVE
	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 FCBDN+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
	LXI	H,CIBUFF
COM4:
	MOV	A,M		;SKIP TO END OF 2ND FILE NAME
	ORA	A		;END OF LINE?
	JRZ	COM5
	CPI	' '		;END OF TOKEN?
	JRZ	COM5
	INX	H
	JR	COM4
;
; LOAD COMMAND LINE INTO TBUFF
;
COM5:
	MVI	B,0		;SET CHAR COUNT
	LXI	D,TBUFF+1	;PT TO CHAR POS
COM6:
	MOV	A,M		;COPY COMMAND LINE TO TBUFF
	STAX	D
	ORA	A		;DONE IF ZERO
	JRZ	COM7
	INR	B		;INCR CHAR COUNT
	INX	H		;PT TO NEXT
	INX	D
	JR	COM6
;
; RUN LOADED TRANSIENT PROGRAM
;
COM7:
	MOV	A,B		;SAVE CHAR COUNT
	STA	TBUFF
	CALL	CRLF		;NEW LINE
	CALL	DEFDMA		;SET DMA TO 0080
	CALL	SETUD		;SET USER/DISK
;
; 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 ON US
	CALL	SETU0D		;SET USER 0/DISK
	CALL	LOGIN		;LOGIN DISK
	JMP	RESTRT		;RESTART CPR
;
; TRANSIENT LOAD ERROR
;
COM8:
	POP	H		;CLEAR RETURN ADDRESS
	CALL	RESETUSR	;RESET CURRENT USER NUMBER
				;  RESET MUST BE DONE BEFORE LOGIN
ERRLOG:
	CALL	DLOGIN		;LOG IN DEFAULT DISK
ERRJMP:
	JMP	ERROR
;
;Section 5L
;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	NOT RAS		;NOT FOR REMOTE-ACCESS SYSTEM
;
GET:
	CALL	HEXNUM		;GET LOAD ADDRESS IN HL
	PUSH	H		;SAVE ADDRESS
	CALL	SCANER		;GET FILE NAME
	POP	H		;RESTORE ADDRESS
	JRNZ	ERRJMP		;MUST BE UNAMBIGUOUS
;
; FALL THRU TO MEMLOAD
;
	ENDIF			;RAS
;
; LOAD MEMORY WITH THE FILE WHOSE NAME IS SPECIFIED IN THE COMMAND LINE
;   ON INPUT, HL CONTAINS STARTING ADDRESS TO LOAD
;
MEMLOAD:
	CALL	MLOAD		;USER MEMORY LOAD SUBROUTINE
	PUSH	PSW		;SAVE RETURN STATUS
	CALL	RESETUSR	;RESET USER NUMBER
	POP	PSW		;GET RETURN STATUS
	RET

;
;  MEMORY LOAD SUBROUTINE
;	EXIT POINTS ARE A SIMPLE RETURN WITH THE ZERO FLAG SET IF NO ERROR,
; A SIMPLE RETURN WITH THE ZERO FLAG RESET (NZ) IF MEMORY FULL, OR A JMP TO
; COM8 IF COM FILE NOT FOUND
;
MLOAD:
	SHLD	LOADADR		;SET LOAD ADDRESS
	CALL	GETUSR		;GET CURRENT USER NUMBER
	STA	TMPUSR		;SAVE IT FOR LATER
	STA	TSELUSR 	;TEMP USER TO SELECT
;
;   MLA is a reentry point for a non-standard CP/M Modification
; This is the return point for when the .COM (or GET) file is not found the
; first time, Drive A: is selected for a second attempt
;
MLA:
	CALL	SLOGIN		;LOG IN SPECIFIED DRIVE IF ANY
	CALL	OPENF		;OPEN COMMAND.COM FILE
	JRNZ	MLA1		;FILE FOUND - LOAD IT
;
; ERROR ROUTINE TO SELECT USER 0 IF ALL ELSE FAILS
;
DFUSR	EQU	$+1		;MARK IN-THE-CODE VARIABLE
	MVI	A,DEFUSR	;GET DEFAULT USER
TSELUSR	EQU	$+1		;MARK IN-THE-CODE VARIABLE
	CPI	DEFUSR		;SAME?
	JRZ	MLA0		;JUMP IF
	STA	TSELUSR		;ELSE PUT DOWN NEW ONE
	MOV	E,A
	CALL	SETUSR		;GO SET NEW USER NUMBER
	JR	MLA		;AND TRY AGAIN
;
; ERROR ROUTINE TO SELECT DRIVE A: IF DEFAULT WAS ORIGINALLY SELECTED
;
MLA0:
	LXI	H,TEMPDR	;GET DRIVE FROM CURRENT COMMAND
	XRA	A		;A=0
	ORA	M
	JNZ	COM8		;ERROR IF ALREADY DISK A:
	MVI	M,1		;SELECT DRIVE A:
	JR	MLA
;
; FILE FOUND -- PROCEED WITH LOAD
;
MLA1:
LOADADR	EQU	$+1		;MEMORY LOAD ADDRESS (IN-LINE CODE MOD)
	LXI	H,TPA		;SET START ADDRESS OF MEMORY LOAD
ML2:
	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	ML3		;READ ERROR OR EOF?
	LXI	D,128		;MOVE 128 BYTES PER SECTOR
	DAD	D		;PT TO NEXT SECTOR IN HL
	JR	ML2
;
ML3:
	DCR	A		;LOAD COMPLETE
	RZ			;OK IF ZERO, ELSE FALL THRU TO PRNLE
;
; LOAD ERROR
;
PRNLE:
	CALL	PRINTC
	DB	'Ful','l'+80H
	MVI	A,1		;SET NON-ZERO TO INDICATE ERROR
	ORA	A		;SET FLAG
	RET
;
	END