;----------------------------- Z40-7.Z80 -------------------------------------
; Integration of RCP definitions (C) Copyright 1992 by Harold F. Bower
;=============================================================================
;		    C L E A R    S C R E E N    C O D E
;=============================================================================
; This block of code clears the screen.  It uses the Termcap definition for
; the Clear Screen function, if available, otherwise it uses a pre-defined
; string set in Z34HDR.

	  IF  clson
CLS:
	   IF  BANKED		;4.0E
	LD	HL,BCLS		;4.0E Point to banked routine
	JR	DOITV		;4.0E ..and execute (short vector)
	COMMON	/BANK2/		;4.0E
BCLS:				;4.0E
	   ENDIF		;4.0E
	   IF  clstcap
	LD	A,(Z3ENV+80H)	; Get the beginning of the TCAP
	CP	' '+1		; Is it a blank?
	LD	HL,CLS2		; .(get No TCAP message)
	JR	C,CLS1		; ..jump if No TCAP

	LD	HL,Z3ENV+97H	; Point to start of Tcap Clear Screen String
CLS1:	JP	PRINTHL		; ..jump to print the addressed string

CLS2:	DEFC	' No TCAP'
	   ELSE		; no clstcap
	CALL	PRINT		; Else do Inline print
	CLSSTR			; .of Macro defined string
	RET			; ..and return
	   ENDIF	; clstcap

	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF	;4.0E banked
	  ENDIF		; clson

;=============================================================================
;	     P E E K    M E M O R Y    C O N T E N T S    C O D E
;=============================================================================
; Display (Dump) memory contents to the Console.  This command takes the Form:
;		PEEK startadr		256 bytes displayed
;		PEEK startadr endadr	range of bytes displayed

	  IF  peekon
PEEK:
	   IF  BANKED		;4.0E
	LD	HL,BPEEK	;4.0E .point to banked routine
	JR	DOITM7		;4.0E ..and execute (short vector)
	COMMON	/BANK2/		;4.0E
BPEEK:				;4.0E
	   ENDIF		;4.0E
	CALL	CRLF		; Start on a new line
	LD	HL,TBUFF+1	; Find first number
	LD	DE,(NXPEEK)	; Get Default Peek address if none
	   IF  BANKED		;4.0E
	CALL	SKSP		;4.0E Else scan for a parameter
	JR	Z,PEEKN2	;4.0E ..quit here if No args at all
	CALL	HEXNUM1		;4.0E Get a Bank Number
	LD	A,(HL)		;4.0E .Get delimiter
	CP	':'		;4.0E Did we have a Bank Number?
	JR	NZ,PEEKN2	;4.0E ..jump to use as start addr if Not
	LD	A,D		;4.0E Else check for too big Bank #
	OR	A		;4.0E Is it > 255?
	JP	NZ,NOARGS	;4.0E ..jump to Bad exit if so
	LD	A,E		;4.0E Else get Bank #
	LD	(PBANK+1),A	;4.0E ..and save
	INC	HL		;4.0E Advance to next character and fall thru
	LD	DE,(NXPEEK)	;4.0E Reload Default Peek address in case none
	   ENDIF
	CALL	SKSP		; Skip to first token (if any)
	CALL	NZ,HEXNUM1	; Get start address if any

PEEKN2:	PUSH	DE		; Save starting address
	LD	BC,255		; Compute default ending address
	EX	DE,HL
	ADD	HL,BC

	   IF  peekchk		; Check for overflow
	JR	NC,PEEK0	; If no overflow past FFFF, go on
	LD	HL,0FFFFH	; Else use FFFF as ending address
PEEK0:
	   ENDIF	; peekchk

	EX	DE,HL		; End address in DE
	CALL	SKSP		; Skip to next token (if any)
	CALL	NZ,HEXNUM1	; Get 2nd number in DE (else default)
	POP	HL		; HL is start address, DE is end address
	   IF  peekhdr
	PUSH	HL		; Save starting address again
	CALL	SPACP		; Output leading spaces

	LD	B,16		; Display 16 column headers
PEEK0B:	LD	A,L		; Get low byte of address
	AND	0FH		; Display low hex digit
	CALL	PASHC
	INC	HL
	DJNZ	PEEK0B

	    IF  peekbdr
	CALL	CRLF
	CALL	SPACP		; Output leading spaces
	LD	B,16
PEEK0D:	CALL	PRINT
	DEFC	' --'
	DJNZ	PEEK0D
	    ENDIF	; prrkbdr
	POP	HL		; Restore starting address
	   ENDIF	; peekhdr

	LD	C,0FFH		; Use C as continue flag
	CALL	PEEK2		; Do peek
	LD	(NXPEEK),HL	; Set continued peek address
	RET			; ..and return to ZCPR

PEEK2:	LD	A,C		; Check continuation flag <jps>
	OR	A		; <jps>
	RET	Z		; <jps>

	CALL	CRLF		; Start New line with Header
	   IF  BANKED		;4.0E
	LD	A,(PBANK+1)	;4.0E Get the Bank #
	CALL	PASHC		;4.0E .print in Hex
	LD	A,':'		;4.0E ..and a Colon
	CALL	CONOUT		;4.0E
	   ENDIF
	CALL	PHL4HC		; Print Address
	CALL	PRINT		; Print leader
	DEFC	' - '
	LD	B,16		; 16 bytes to display
	PUSH	HL		; Save start address

; Print hex values for 16 bytes

PEEK3:
	   IF  BANKED		;4.0E
	CALL	GBBYT		;4.0E Get a byte from Bank via Bios
	   ELSE			;4.0E
	LD	A,(HL)		; Get next byte
	   ENDIF		;4.0E
	CALL	PASHC		; Print with leading space.  Check for last
				; addr <jps>.  If C already 0, leave that way.
				; Else check for End addr and set C to 0 if so.
	LD	A,C		; See if continue flag already cleared
	OR	A
	JR	Z,PEEK3A	; If so, skip test
	LD	A,H
	SUB	D		; See if h = d
	LD	C,A
	LD	A,L
	SUB	E		; See if l = e
	OR	C		; Combine two tests
	LD	C,A

PEEK3A:	INC	HL		; Pt to next
	DJNZ	PEEK3

; Print ascii equivalents for 16 bytes

	POP	HL		; Pt to first address again
	LD	B,16		; 16 bytes
	CALL	PRINT		; Space and fence
	DEFC	' ',FENCE
	PUSH	BC		; Save flag in c
	   IF  BANKED		;4.0E
PEEK4:	CALL	GBBYT		;4.0E Get a byte from Bank via Bios
	   ELSE			;4.0E
PEEK4:	LD	A,(HL)		; Get next byte
	   ENDIF		;4.0E
	AND	7FH		; Mask it
	CP	' '		; Dot if less than space
	JR	C,PEEK5
	CP	7FH		; Don't print del
	JR	NZ,PEEK5A	; ..jump if Not Del
PEEK5:	LD	A,'.'		; Print Period if not printable
PEEK5A:	CALL	CONOUT		; Send it
	INC	HL		; Pt to next
	DJNZ	PEEK4

	CALL	PRINT		; Closing fence
	DEFC	FENCE
	CALL	BREAK		; Check for Console char.  Set Z on Ctrl-C
	POP	BC		; Get flag in C back
	RET	Z		; ..Quit here if Control-C detected
	JR	PEEK2
	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF	;4.0E banked
	  ENDIF		; peekon

;=============================================================================
;		P O K E    V A L U E S    I N T O    M E M O R Y
;=============================================================================
; This command permits directly changing values within the addressable memory
; space.  It is dangerous, and should always be Wheel Protected.

; It is executed with the form:		POKE startadr val1 val2 ...

	  IF  pokeon
POKE:
	   IF  BANKED		;4.0E
	LD	HL,BPOKE	;4.0E .point to banked routine
	JR	DOITM7		;4.0E ..and execute (short vector)
	COMMON	/BANK2/		;4.0E
BPOKE:				;4.0E
	   ENDIF		;4.0E
	CALL	CRLF		; Start on a new line
	CALL	SETLN		; Point to first Non-blank Char
	CALL	HEXNUM1		; Convert to number

	   IF  NOT pokeq
	CALL	PRINT
	DEFC	' Poke at'
	EX	DE,HL		; Put address in HL
	CALL	PHL4HC		; Print at message
	EX	DE,HL		; ..now put addr back
	   ENDIF
	   IF  BANKED		;4.0E
	LD	A,(TPABNK)	;4.0E Get TPA Bank #
	LD	C,A		;4.0E ..and save for work
	   ENDIF		;4.0E

; Loop for Storing Hex Values sequentially via Poke

POKE1:	CALL	SKSP		; Skip to non-blank
	RET	Z		; ..and return to ZCPR if Done
	CP	'"'		; Quoted text?
	JR	Z,POKE2
	PUSH	DE		; Save address
	PUSH	BC		;4.0E
	CALL	HEXNUM1		; Get number
	POP	BC		;4.0E
	LD	A,E		; Get low
	POP	DE		; Get address
	   IF  BANKED		;4.0E
	CALL	PUTCHB		;4.0E
	   ELSE			;4.0E
	LD	(DE),A		; Store number
	   ENDIF		;4.0E
	INC	DE		; Pt to next
	JR	POKE1

; Store ASCII Chars

POKE2:	INC	HL		; Pt to next char
POKE3:	LD	A,(HL)		; ..and Get it
	OR	A		; Done?
	RET	Z		; ..return to ZCPR if So
	   IF  BANKED		;4.0E
	CALL	PUTCHB		;4.0E
	   ELSE			;4.0E
	LD	(DE),A		; Put char
	   ENDIF		;4.0E
	INC	HL		; Pt to next
	INC	DE
	JR	POKE3

	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF		;4.0E
	  ENDIF		; Pokeon

;=============================================================================
;	D I S K    R E S E T    C O M M A N D
;=============================================================================
; This command resets the complete disk system with a Function 37.  It thereby
;  will cause Hard Disks to also be relogged even though they are declared as
;  non-removeable.
; Comments:  ZRDOS does not require a disk system reset when disks are changed,
;	but directory programs will not show the correct size if this is not
;	done.  It is also good practice.  Since no warm boot performed, the
;	disk in drive A need not have the operating system on it.

	  IF  reson
RESET:
	   IF  BANKED		;4.0E
	LD	HL,BRESET	;4.0E Point to banked routine
	JR	DOITV		;4.0E ..and execute (short vector)
	COMMON	/BANK2/		;4.0E
BRESET:				;4.0E
	   ENDIF		;4.0E
	LD	C,B_RESDR	; Selected Disk Reset BDOS Function
	LD	DE,0FFFFH	; ..of All disks on system
	   IF  RESMSG		; If displaying a reset message
	CALL	BDOS		; .Reset the disk system
	CALL	PRINT		; ..Report action
	DEFC	CR,LF,TAB,'Reset'
	    IF  ZSDOS
	RET			; ZsDos does auto relog of current, just Ret
	    ENDIF
	   ELSE			; If Not resmsg
	    IF  ZSDOS
	JP	BDOS		; ..Reset disk system and return to CPR
	    ELSE		; If NOT ZsDos..
	CALL	BDOS		; Reset the disk system
	LD	A,(CURDR)	; .get the current drive
	JP	SETDRIVE	; ..relog it and exit
	    ENDIF	; zsdos
	   ENDIF	; resmsg
	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF	;4.0E Banked
	  ENDIF		; reson

;=============================================================================
;		D I S K    S P A C E    C O M M A N D
;=============================================================================
; This Command simply prints the Free Space on a specified or default drive.
; The syntax takes the Form:		SP [DIR: | DU:]

; NOTE: If using ZSDOS2, the Default Buffer at 80H is altered by returning the
;	four bytes of sizing information.  This buffer will be either in the
;	TPA Bank if Unbanked, or in the SYStem bank if banked.

	  IF  erasp OR cpsp OR dirsp OR freeon
FREE:	CALL	CRLF		; Put space on new line for these
FREENC:	LD	A,(TFCB)	; Get specified drive

	   IF  BANKED		;4.0E If going to bank, keep FCB drive from TPA
	LD	HL,BFREE0	;4.0E Point to Banked Routine
	JR	DOITV		;4.0E ..and execute (short vector)
	COMMON	/BANK2/		;4.0E
BFREE0:				;4.0E
	   ENDIF	;4.0E banked

	OR	A		; Is Default Drive requested?
	CALL	Z,GETDRV	; Get Current Drive from Dos if Default
	DEC	A		; Change base back to 0..15
	LD	E,A		; Save in E for selecting disk below
	ADD	A,'A'		; Convert to letter and
	PUSH	AF		; ..save on stack
	   IF  ZSDOS2
	LD	C,B_GFREE	; ZSDOS2 Return Disk Free Space function
	CALL	BDOS
	POP	BC		; Return Drive letter to B
	OR	A		; Error?
	RET	NZ		; ..return if so
	   ELSE		; not zsdos
	LD	C,B_SDRV	; BDOS Select disk function
	CALL	BDOS		; Not needed if no drive sel, but small code

; Here we extract the following disk parameter information from the disk
; parameter block (DPB):
;	BLKSHF: block shift factor (1 byte)
;	BLKMAX: max number of blocks on disk (2 bytes)

DPARAMS: LD	C,B_GDPB	; BDOS get disk parameters function
	CALL	BDOS
	INC	HL		; Advance to block shift factor byte
	INC	HL
	LD	A,(HL)		; Get value and
	PUSH	AF		; ..save on stack
	INC	HL		; Advance to max block number word
	INC	HL
	INC	HL
	LD	E,(HL)		; Get value into HL
	INC	HL
	LD	D,(HL)
	INC	DE		; Add 1 for max number of blocks

; Compute amount of free space left on disk

DFREE:	LD	C,B_GALV	; BDOS get allocation vector function
	PUSH	DE		; Save BLKMAX value
	CALL	BDOS		; Get allocation vector into HL
	LD	B,H		; ..copy allocation vector to BC
	LD	C,L
	POP	HL		; Restore MAXBLK value to HL
	LD	DE,0		; Initialize count of free blocks

; At this point we have
;	BC = Allocation Vector address
;	DE = Free Block Count
;	HL = Number of Blocks on disk

FREE1:	PUSH	BC		; Save allocation address
	LD	A,(BC)		; Get bit pattern of allocation byte
	LD	B,8		; Set to process 8 blocks
FREE2:	RLA			; Rotate allocated block bit into carry flag
	JR	C,FREE3		; ..If set (bit=1), block is allocated
	INC	DE		; If not set, block is not allocated, so
				; ..increment Free Block count
FREE3:	LD	C,A		; Save remaining allocation bits in C
	DEC	HL		; Count down number of blocks on disk
	LD	A,L		; See if we are down to zero
	OR	H
	JR	Z,FREE4		; ..branch if no more blocks to check
	LD	A,C		; Get back current Allocation Bit pattern
	DJNZ	FREE2		; ..loop through 8 bits
	POP	BC		; Get pointer to Allocation Vector
	INC	BC		; ..point to Next Allocation Byte
	JR	FREE1		; Continue by processing next Allocation Byte

FREE4:	POP	BC		; Free up stack
	EX	DE,HL		; Free Block count to HL
	POP	AF		; ..restore Block Shift Factor from Stack
	SUB	3		; Convert to Log base 2 of K per block
	JR	Z,FREE6		; ..done if single density (1k per Block)

FREE5:	ADD	HL,HL		; Convert for Block of more than 1k each
	DEC	A
	JR	NZ,FREE5
	POP	BC		; Restore Drive letter to B
FREE6:
	   ENDIF	; not zsdos2
			;..and fall thru
; At this point, we have Number of K Free Space in a 4-byte field in TBUFF

	CALL	PRINT
	DEFC	'  Free on '
	LD	A,B		; Get Drive letter back to A
	CALL	CONOUT		; .print it
	CALL	PRINT		; ..and the rest of the line
	DEFC	': '
	  IF  ZSDOS2		;4.0E
	LD	HL,TBUFF	;4.0E Point to returned buffer (SYS or TPA Bank)
	LD	E,(HL)		;4.0E Get LSB
	INC	HL		;4.0E
	LD	D,(HL)		;4.0E .middle byte
	INC	HL		;4.0E
	LD	A,(HL)		;4.0E ..and MSB
	EX	DE,HL		;4.0E Swap to HL
	  ENDIF		;4.0E zsdos2

	CALL	PRBIG		;4.0E Print the #K in Decimal range 0..999,999
	LD	A,'K'
	JP	CONOUT		; Jump to Print "K" and return

;.....
;4.0E Print contents of AHL as up to 6 decimal digits

PRBIG:	LD	E,A		; Save MSB
	XOR	A		; Set flag for no digits yet
	LD	(BIGFLG+1),A	; ..and save
	LD	A,E		; Restore flag
	LD	DE,86A0H	; 100,000 = 0186A0H, set lower 2 bytes
	LD	B,01		; ..and MSB
	CALL	DIVBIG		; Divide and print
	LD	DE,10000	; Set 10k lower 2 bytes
	LD	B,0		; and MSB
	CALL	DIVBIG		; Divide and print
BIGFLG:	LD	B,00		; .to register (inline modified)
	JP	PRSZ1K		; ..and continue below

DIVBIG:	LD	C,-1		; Set initial result
	OR	A		; Clear Carry
DIVBL:	INC	C		; Bump count
	SBC	HL,DE		; .subtract lower 2 bytes
	SBC	A,B		; ..and upper byte
	JR	NC,DIVBL	; ...looping til done
	ADD	HL,DE		; Correct for underflow
	ADC	A,B
	LD	E,A		; .(save MSB)
	LD	A,C		; Get Result
	OR	A		; Is digit 0?
	JR	NZ,DIVBP	; ..jump if Not
	LD	A,(BIGFLG+1)	; Get Prior digit print flag
	OR	A		; Anything printed yet?
	JR	Z,DIVBX		; ..jump if Not
	XOR	A		; Else print a Zero
DIVBP:	ADD	A,'0'		; Make digit Ascii
	LD	(BIGFLG+1),A	; ..save as new flag
	CALL	CONOUT		; Print digit
DIVBX:	LD	A,E		; Get MSB back
	RET			; ..and quit

	   IF  BANKED		;4.0E
	CSEG			;4.0E Generate Common Code again
	   ENDIF	;4.0E banked
	  ENDIF		; freeon

;=============================================================================
;			  H E L P    C O M M A N D
;=============================================================================
; This command displays a list of all resident commands that are supported,
; including those in the CPR (Command Processor), RCP, and FCP.

; Print the CPR-resident command names

	  IF  helpon
HELP:
	   IF  BANKED		;4.0E
	LD	HL,BHELP	;4.0E Point to banked routine
DOITV:	JP	DOIT		;4.0E ..and execute!
	COMMON	/BANK2/		;4.0E
BHELP:				;4.0E
	   ENDIF
	CALL	PRINT		; Print "CPR"
	DEFC	CR,LF,LF,'CPR'
	LD	HL,CMDTBL	; Point to the CPR Command Table
	  IF  listrcp OR listfcp
	CALL	CMDLST		; Display the list of Commands
	  ENDIF

; Print the RCP-resident command names

	  IF  listrcp
	LD	HL,(Z3ENV+0CH)	; Get RCP address
	CALL	PKGOFF		; See if implemented & Offset to start
	  IF  listfcp
	JR	Z,NORCP		; ..jump if Not implemented
	  ELSE
	RET	Z		; ..return if not implemented & No FCP
	  ENDIF		; listfcp

	CALL	PRINT		; Print header for RCP
	DEFC	CR,LF,LF,'RCP'
	   IF  listfcp
	CALL	CMDLST		; List the RCP Commands
	   ENDIF	; listfcp
	  ENDIF		; listrcp

; Print the FCP-resident command names

	  IF  listfcp
NORCP:	LD	HL,(Z3ENV+12H)	; Get FCP address
	CALL	PKGOFF		; See if implemented & Offset to start
	RET	Z		; ..return if Not implemented

	CALL	PRINT		; Print header for FCP
	DEFC	CR,LF,LF,'FCP'
	  ENDIF		; listfcp
			;..and fall thru to CMDLIST

;----------------------------------------
; Subroutine to display list of commands in a command table (code above
; falls through to this routine -- do not move it).  The commands are
; displayed 5 per line with 8 character spaces allowed for each command
; (subject to equates below).

CMDLST:	CALL	CRLF		; Start with new line
	LD	E,(HL)		; Get size of each command name into DE
	LD	D,0
	INC	HL		; Point to name of first command
	LD	C,CMDSLIN	; Set names-per-line value

CMLST1:	LD	A,(HL)		; Get first character of the command name
	OR	A		; See if it is null
	JR	NZ,CMLST1A	; If not, continue
	LD	A,CMDSLIN	; See if we are already on a new line
	CP	C
	CALL	NZ,CRLF		; If not, skip a line
	RET

CMLST1A:
	  IF  noshow		; Option to suppress wheel-limited cmds
	RLA			; Shift high bit of name into carry bit
;4.0E	JR	NC,CMLST2	; ..if not restricted, go on
	LD	A,00		;4.0E Set Flag for No output case conversion
	JR	NC,CMLS1B	;4.0E ..and carry on since Not restricted
	CALL	WHLCHK		; Otherwise, check Wheel Byte
;4.0E	JR	NZ,CMLST2	; ..if wheel set, continue as usual
	LD	A,0FFH		;4.0E .(set flag to convert to Lowercase)
	JR	NZ,CMLS1B	;4.0E ..and carry on since we are WHEEL
	ADD	HL,DE		; Otherwise skip this command
	JR	CMLST5
	  ENDIF		; noshow

;4.0E If we are a WHEEL, print restricted commands in Lower Case

CMLS1B:	LD	(CMLST4+1),A	;4.0E Save Output case flag

; Print leading spaces between names

;4.0ECMLST2:
	LD	A,CMDSPAC	; Spacing between command names
	SUB	E		; Less length of each command name
	LD	B,A
	CALL	SPACER		; Send spaces to pad out

; Print name of command

	LD	B,E		; Length of each name into B
CMLST4:	LD	A,$-$		;4.0E Set flag for Upper/Lower case (inline mod)
	OR	A		;4.0E .test the flag
	LD	A,(HL)		; Get command name character
	CALL	NZ,LCASE	; .convert to Lowercase if needed
	CALL	CONOUT		; ..print
	INC	HL		; Point to next
	DJNZ	CMLST4

	DEC	C		; Decrement count of names on this line
	JR	NZ,CMLST5	; Branch if room for more names
	CALL	CRLF		; Otherwise, end this line and
	LD	C,CMDSLIN	; ..reset count for another line of commands

; Skip to next command name

CMLST5:	INC	HL		; Skip jump vector
	INC	HL
	JR	CMLST1		; Back to process next name
	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF	;4.0E banked
	  ENDIF		; helpon

;=============================================================================
;		   F I L E    C O P Y    C O M M A N D
;=============================================================================
; CP copies a file from one place to another.  Both file specifications can
; include a directory specification.  If only one file name is given, then the
; current directory and the source file name are assumed for the destination.
; The syntax for this command is:
;		CP destfile=srcfile
;		CP srcfile

	  IF  copyon
COPY:
	   IF  BANKED		;4.0E
	LD	HL,BCOPY	;4.0E .point to banked routine
DOITM7:	JP	DOITMV		;4.0E ..and execute
	COMMON	/BANK2/		;4.0E
BCOPY:				;4.0E
	   ENDIF		;4.0E
	LD	HL,TFCB+1
	CALL	AMBCK0		; Check for Ambiguous First FN.FT, Abort if so
	LD	HL,TFCB2+1
	CALL	AMBCK0		; ..now check second as well

;4.0E Check for "fn.ft=fn.ft" format or "fn.ft fn.ft" format, reverse if latter

	CALL	CHKREV		;4.0E Position fn.ft's according to syntax

; If new is blank, make it the same name and type as old

	LD	DE,TFCB+1	; Point to destination file name
	LD	A,(DE)		; Get first character
	CP	' '		; If not blank (no name)
	JR	NZ,COPY0	; ..then branch to copy

	LD	HL,TFCB2+1	; Copy source name into destination FCB
	LD	BC,11		; Name and type are 11 bytes
	LDIR

; See if destination is same as source, and abort if so

COPY0:	LD	HL,TFCB		; Set up pointers to two files
	LD	DE,TFCB2
	PUSH	HL
	PUSH	DE
	INC	HL		; Point to names of files
	INC	DE
	LD	B,13		; Compare 13 bytes (name, type, and user #)
COPY1:	LD	A,(DE)		; Get char from TFCB2
	SUB	(HL)		; .compare to char from TFCB w/Sub as flag
	JR	NZ,COPY2	; ..jump if they differ, go on w/copy
	INC	DE		; Advance to next char
	INC	HL
	DJNZ	COPY1		; ..loop til done

COPY2:	PUSH	AF		;4.0E Save results of Fn.Ft Compare
	CALL	GETDRV		; Get current Disk from BDOS
	LD	B,A		; ..and keep value in B
	POP	AF		;4.0E .(restore Comp results)
	POP	DE		; Restore pointers to FCBs
	POP	HL
	PUSH	AF		;4.0E ..save Comparison results again
	LD	A,(DE)		; Get drive of source file
	LD	C,A		; ..and save it in C
	OR	A		; Is it default drive?
	JR	NZ,COPY1A	; Branch if drive made explicit
	LD	C,B		; Otherwise, copy Default Drive into C
	LD	A,B		;4.0E .load the Default Drive
COPY1A:	LD	(DE),A		;4.0E ..Save the Real Drive in Source FCB
	LD	A,(HL)		; Get drive of destination file
	OR	A		; Is it default drive?
	JR	NZ,COPY1B	; ..Branch if drive made explicit
	LD	A,B		; Otherwise, get current drive
COPY1B:	LD	(HL),A		;4.0E ..save real Drive in FCB
	POP	AF		;4.0E Were Filenames different?
	JR	NZ,COPY3	;4.0E ..jump if so
	LD	A,(HL)		;4.0E Get drive back
	CP	C		; Are the two drives different?
	JR	Z,CPERR		;4.0E ..jump if Not to Error

; Make note of the user numbers of the two files

COPY3:	LD	HL,(TFCB+13)	; Get destination user number to L
	LD	A,(TFCB2+13)	; Get source user number
	LD	H,A		; ..to H
	LD	(USRDST),HL	; Save both values in Data Segment

; Set up new FCB for source file and open the source

	CALL	GETTOP		; Get Top of Avail Memory w/RSX sensing
	   IF  CPTIM
	DEC	H		; Back down a page for Stamp buffer
	LD	(FSTAMP),HL	; ..and save pointer
	   ENDIF	 ; cptim
	   IF  BANKED		;4.0E If banked, check for >= 8000H to prot SYStem
	BIT	7,H		;4.0E <8000H?
	JR	Z,CANTER	;4.0E ..jump to Error if so
	XOR	A		;4.0E Else set counter to start
	LD	DE,128		;4.0E .and Load Sector Size
CBFSIZ:	OR	A		;4.0E Clear Carry
	INC	A		;4.0E .Bump Sector Count
	SBC	HL,DE		;4.0E ..subtract another sector from Address
	JP	M,CBFSIZ	;4.0E ...loop if still >= 8000H
	ADD	HL,DE		;4.0E Else correct for underflow
	DEC	A		;4.0E .correct count
	JR	Z,CANTER	;4.0E ..jump to Error if Zero Sectors
	LD	(CBUFF),HL	;4.0E Save Buffer Starting Address
	LD	(CPSIZE+1),A	;4.0E ..and Sector Count (inline)
	   ELSE			;4.0E
	LD	DE,CPBLKS*128	; Get Buffer Size in Bytes
	OR	A
	SBC	HL,DE		; Subtract Buffer size from Buffer Top
	JR	C,CANTER	; ..jump if not enough TPA space
	INC	H
	DEC	H		; Did we impinge on Page 0?
	JR	Z,CANTER	; ..jump to error if so
	LD	(CBUFF),HL	; Else save the Buffer Base address
	   ENDIF		;4.0E

	LD	DE,CMDFCB	; Get address to use for new source FCB
	PUSH	DE
	LD	HL,TFCB2	; .and Get source FCB
	LD	BC,14		;4.0E
	LDIR			; ..Copy file data to new FCB
	CALL	LOGSRC		; Log in user number of source file
	POP	DE		; Restore Source FCB pointer

	  IF  zsdos AND cptim
	LD	A,B_GSTMP	; Get File Stamp Comnd
	CALL	GPSTMP		; .preserving registers & DMA
	  ENDIF		; zsdos and cptim

	CALL	OPEN		; Open File and check for Error
	JP	Z,PRNNF		; ..print No File & Abort if Error

; Make sure destination file does not already exist

	CALL	LOGDEST		; Log into destination s user area
	CALL	EXTEST		; Test for File Existence (query Erase if so)
	LD	DE,TFCB		; Point to destination FCB
	LD	C,B_FMAK	; BDOS make-file function
	CALL	BDOSSAVE
	INC	A		; Test for error (no directory space)
	JR	NZ,COPY5	; Branch if OK
				; Report file error
CPERR:	CALL	PRINT
	DEFC	CR,LF,' Copy?'
	RET

; Report Insufficient Space Error

CANTER:	CALL	PRINT
	DEFC	CR,LF,' Can''t!'
	RET

; Copy source to destination with buffering

COPY5:	CALL	LOGSRC		; Log in source user area
	LD	BC,0		; Initialize counter
	LD	HL,(CBUFF)	; Initialize buffer pointer

COPY5A:	CALL	RDFILE		; Read Sctr to DMA(HL) from EXTFCB, bumping DMA
	JR	NZ,COPY5B	; ..branch if End-of-File (or Error)

	INC	BC		; Increment Count
	   IF  BANKED		;4.0E
CPSIZE:	LD	A,$-$		;4.0E Load Max Sector Count (inline mod)
	DEC	A		;4.0E .correct for check
	CP	C		;4.0E Are we still Ok?
	JR	NC,COPY5A	;4.0E ..jump if still more room
	   ELSE			;4.0E
	LD	A,C		; See if buffer full
	CP	CPBLKS
	JR	NZ,COPY5A	; If not, go back for more
	   ENDIF		;4.0E

COPY5B:	LD	A,B		; Get count of blocks loaded into buffer
	OR	C		; Are there any?
	JR	Z,COPY6		; Branch if not (we are done)

	CALL	LOGDEST		; Log into destination user number
	LD	HL,(CBUFF)	; Point to beginning of copy buffer
	CALL	WRFILE		; Write (BC) Sectors to File at TFCB
	JR	Z,COPY5		; ..then back to read more if No Errors

; Close the destination file

COPY6:	PUSH	AF		; Preserve status
	CALL	LOGDEST		; Log into destination user number
	CALL	CLOSETF		; Close the file
	POP	AF		; .restore previous status
	JR	NZ,CPERR	; ..and jump if Write Error
	  IF  ZSDOS AND CPTIM
	LD	A,(STATUS)	; Get status from Read Stamp
	OR	A		; Good?
	LD	A,B_PSTMP	; .set Write File Stamp Comnd
	CALL	Z,GPSTMP	; ..write Stamp data if Read Ok
	  ENDIF		; zsdos and cptim
	CALL	PRINT
	DEFC	CR,LF,' Done'

	  IF  cpsp AND freeon
	JP	FREENC		; Report space remaining on dest drive
	  ELSE
	RET
	  ENDIF		; cpsp and spaceon

	  IF  ZSDOS AND CPTIM
GPSTMP:	PUSH	AF		; Save the function number
	PUSH	DE		; Save FCB addr
	LD	DE,(FSTAMP)	; Get pointer to File stamp
	CALL	DMASET		; ..and set the DMA addr
	POP	DE		; Restore FCB Addr
	POP	AF		; .and Function #
	LD	C,A		; ..to right Reg
	CALL	BDOSSAVE	; Do the Function
	DEC	A		; ..(1-->0 if good)
	LD	(STATUS),A	; ..and Stamp status
	PUSH	DE		; Save the FCB again
	CALL	DEFLTDMA	; Restore the default DMA to 80H
	POP	DE		; .restoring the FCB Ptr
	RET
	  ENDIF		; zsdos and cptim

; Log into user number of source file

LOGSRC:	LD	A,(USRSRC)	; Get user number
	JR	SUSREL		; Local jump to save code

; Log into user number of destination file

LOGDEST: LD	A,(USRDST)	; Get user number
SUSREL:	 JP	SETUSER
	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF		;4.0E
	  ENDIF		; copyon

;=============================================================================
;	     S E N D    F O R M    F E E D    T O    P R I N T E R
;=============================================================================
; This command simply sends a Carriage Return (to flush any buffers) followed
; by a Form Feed character (0CH) to the current LST: device (printer).

	  IF  feedon
FEED:
	   IF  BANKED		;4.0E
	LD	HL,BFEED	;4.0E Point to banked routine
	JR	DOITV		;4.0E ..and execute! (short vector)
	COMMON	/BANK2/		;4.0E
BFEED:				;4.0E
	   ENDIF	;4.0E banked
	   IF  lton		; Is LIST is on, share some code
	LD	A,CR		; Send a Carriage return
	CALL	LOUT		; ..via a LIST routine
	LD	A,FF		; Then a Form feed
	JP	LOUT		; ..and return via stack
	   ELSE
	LD	C,B_SLST	; List Out Function
	LD	E,CR
	CALL	BDOSSAVE	; Send a Carriage Return to the Printer
	LD	E,FF
	JP	BDOSSAVE	; ..then a Form Feed, and return
	   ENDIF	; not lton
	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF	;4.0E banked
	  ENDIF		; feedon

;=============================================================================
;	    M A N I P U L A T E    M E M O R Y    R E G I S T E R S
;=============================================================================
; REG Command to Manipulate Memory Registers.  This command takes the Forms:
;	REG D or REG		<-- Display Register Value
;	REG Mreg		<-- Decrement Register Value
;	REG Preg		<-- Increment Register Value
;	REG Sreg value		<-- Set Register Value

	  IF  regon
REGISTR:
	   IF  BANKED		;4.0E
	LD	HL,REG0		;4.0E .point to banked routine
	JR	DOITM7		;4.0E ..and Execute! (short vector)
	COMMON	/BANK2/		;4.0E
REG0:				;4.0E
	LD	DE,TFCB+2	; Pt to first arg
	LD	A,(DE)		; Get possible digit
	CALL	REGPTR		; Point to Memory Register
	DEC	DE		; .Back up to Command
	LD	A,(DE)		; ..and get Command
	CP	'S'		; Set?
	JR	Z,RSET
	CP	'P'		; Plus?
	JR	Z,RINC
	CP	'M'		; Minus?
	JR	Z,RDEC

; Show Register Values

	CALL	CRLF		; Start on New line
	XOR	A		; Select register 0
	LD	B,A		; Counter set to 0 in B
	CALL	REGP2		; HL pts to register 0
RSHOW1:	LD	A,B		; Get counter value
	CP	10
	RET	Z		; Exit if done
	CALL	PRINT
	DEFC	'    Reg '
	LD	A,B		; Print register number
	ADD	A,'0'
	CALL	CONOUT
	CALL	PRINT
	DEFC	' ='
	PUSH	BC		; Save counter
	PUSH	HL		; Save pointer
	CALL	PRINT		; Print leading space
	DEFC	' '
	LD	L,(HL)		; Get register value
	LD	H,0		; .set High Byte to 0
	CALL	PRSIZ16		; ..and print value
	POP	HL		; Get pointer
	POP	BC		; Get counter
	INC	B		; Increment counter
	LD	A,B		; Check for new line
	CP	5		; New line after fifth register display
	CALL	Z,CRLF
	INC	HL		; Pt to next register
	JR	RSHOW1

; Set Register Value.  HL pts to Register on Input

RSET:	PUSH	HL		; Save Register pointer
	LD	HL,TFCB2+1	; Point to value to convert
	CALL	DECIMAL1	; Get number from second FCB field
	POP	HL		; Restore Register pointer
			;++ Error?
	DEC	E		; .(back down on value for next INC)
	LD	(HL),E		; Set value from Low byte
			;..fall thru to..
; Increment Register Value.  HL pts to Memory Register on Input

RINC:	INC	(HL)		; Increment it
	DEFB	0EH		; Trash C & next DEC instruction w/"LD  C,35H"
			;..and fall thru RDEC to Print result
; Decrement Register Value.  HL pts to Memory Register on Input

RDEC:	DEC	(HL)		; Decrement value

; Entry point with setting of error flag

	   IF  seterr		; Set error flag
	LD	A,(HL)		; Get register value
	LD	(Z3MSG+6),A	; Copy into program error flag
	   ENDIF
	RET

;.....
; Set HL to point to Memory Register whose index is pointed to by HL
;  On Input, A contains Register Character
;  On Output, HL = Address of Memory Register (Reg 0 assumed if Error)

REGPTR:	LD	B,0		; Set default Register to Zero
	SUB	'0'		; Convert Ascii to Binary
	JR	C,REGP1		; ..jump if Digit < '0'
	CP	10		; Is it in 0..9?
	JR	NC,REGP1	; ..jump if Not to assume 0
	LD	B,A		; Put specified Value in B
REGP1:	LD	A,B		; Get desired Value in A
REGP2:	LD	HL,(Z3ENV+22H)	; Get pointer to Z3MSG Buffer Area
	ADD	A,30H		; .add offset to Base Memory Registers
	JP	ADDAH		; ..and offset to proper register and return

	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF		;4.0E
	  ENDIF		; regon

;=============================================================================
;	   M A N I P U L A T E    Z C P R 3    W H E E L    B Y T E
;=============================================================================
; This WHL Command is used to Set the Wheel Byte On or Off, and query status.

; If WHLQUIET equate is true, then RCP does not report wheel status with WHL
; Command.  This Command takes the Form:

;	WHL		-- turn Wheel Byte OFF
;	WHL password	-- turn Wheel Byte ON if password is correct
;			   no change if password is wrong
;	WHLQ		-- find out status of Wheel Byte

	  IF  whlon
WHL:
	   IF  BANKED		;4.0E
	LD	HL,BWHL		;4.0E
	JR	DOITM7		;4.0E (short vector)
	COMMON	/BANK2/		;4.0E
BWHL:				;4.0E
	   ENDIF		;4.0E
	LD	HL,TFCB+1	; Pt to first char
	LD	A,(HL)		; Get it
	CP	' '		; Is it just a request for Wheel Status?
	JR	Z,WHLMSG	; ..jump if so
	LD	DE,WHLPASS	; Else..
	LD	B,8		; .Check 8 chars
	CALL	PWCK		; ..against our embedded PW
	JR	NZ,WHLOFF	; Mismatch turns Wheel OFF ALWAYS!
	LD	A,(HL)		; Insure complete match
	CP	' '		; Did User entry also end?
	LD	A,0FFH		; .(prepare for Yes)
	JR	Z,WHLSET	; ..and jump to enable if Complete Match
			;..else fall thru to Turn Off
WHLOFF:	XOR	A		; Turn off wheel byte
WHLSET:	LD	HL,(Z3ENV+29H)	; Get Wheel Byte address
	LD	(HL),A		; ..set value and print message
WHLMSG:
	   IF  whlquiet
	RET			; If Quiet, quit here
	   ELSE			; Else print Wheel Status
	CALL	PRINT		; Print Wheel Byte Message
	DEFC	CR,LF,' Wheel Byte '
	CALL	WHLCHK		; Get wheel byte value
	JR	Z,OFFM		; ..jump if Wheel turned Off
	CALL	PRINT		; Print ON
	DEFC	'ON'
	RET			; ..and return

OFFM:	CALL	PRINT		; Print OFF
	DEFC	'OFF'
	RET
	   ENDIF	; not whlquiet

; Wheel Password Defined from Z35HDR.LIB File

	DEFB	'Z'-'@'		; Leading ^z to block attempt to type file
WHLPASS:
	WPASS			; Use macro

	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF		;4.0E
	  ENDIF		; whlon

;=============================================================================
;		   E R R O R    T E S T    C O M M A N D
;=============================================================================
; TST - Sets the Message Buffer Program Error Flag based on the Error Count
;	reported by M80 or L80 (NOTE: This is program-specific).
;	  The syntax is:
;		TST PN	where PN is (at least) the first letter of M80 or L80

; Check for name of program to test

	  IF  tston
TSTERR:	LD	A,(TFCB+1)	; Get first character in program name

	   IF  tstm80
	LD	HL,M80F		; Preset for m80 test counts
	LD	DE,M80W
	CP	'M'
	JR	Z,TSTCNT
	   ENDIF	; tstm80

	   IF  tstf80
	LD	HL,F80F
	LD	DE,F80W
	CP	'F'
	JR	Z,TSTCNT
	   ENDIF	; tstf80

; If no match, give error message

	CALL	PRINT
	DEFC	'Bad Name'

TSTCNT:	LD	A,(HL)		; Test first error count word
	INC	HL
	OR	(HL)
	EX	DE,HL		; Test second word
	OR	(HL)
	INC	HL
	OR	(HL)
	LD	HL,Z3MSG+6	; Point to program error flag
	LD	(HL),0		; Clear it
	RET	Z		; If counts were zero, we are done
	DEC	(HL)		; Else set the error flag to 0FFH
	RET
	  ENDIF		; tston

;=============================================================================
;	   S E T    F I L E    A T T R I B U T E S    C O M M A N D
;=============================================================================
; PROT - Set the attributes of a file (R/O and SYS).  The syntax is:

;	PROT afn RSI
; If either R or S are omitted, the file is made R/W or DIR, resp;
;  R and S may be in any order.  If I is present, Inspection is enabled.

	  IF  proton
PROT:
	   IF  BANKED		;4.0E
	LD	HL,BPROT	;4.0E .point to banked routine
	JR	DOITM7		;4.0E ..and execute (short vector)
	COMMON	/BANK2/		;4.0E
BPROT:	LD	DE,TFCB2+1	; Pt to attributes
	XOR	A		; Set no inspect
	LD	(INSPECT),A
	LD	H,A		; Set r/o and sys attributes off
	LD	L,A
	LD	B,3		; 3 chars max
ATT1:	LD	A,(DE)		; Get char
	INC	DE		; Pt to next
	CP	'I'		; Inspect?
	JR	NZ,ATT1A	; ..jump if Not
	LD	(INSPECT),A	; Else set Inspect flag
ATT1A:	CP	'R'		; Set R/O?
	JR	NZ,ATT1B	; ..jump if Not
	LD	H,80H		; Else set R/O Mask byte
ATT1B:	CP	'S'		; Set SYS?
	JR	NZ,ATT2		; ..jump if Not
	LD	L,80H		; Else set SYS Mask byte
ATT2:	DJNZ	ATT1		; ..loop til 3 chars set
			;..then fall thru..
	LD	(FATT),HL	; Save file attributes
	CALL	GETDIR		; Load directory
	JP	Z,PRNNF		; No file error

ATT4:	CALL	BREAK		; Check for possible abort
	RET	Z		; ..exit here if so
	CALL	CRLF		; New line
	LD	HL,(NXTFIL)	; Point to next file
	LD	A,(HL)		; Get first char
	OR	A		; End-Of-File?
	RET	Z		; ..quit if so
	PUSH	HL		; Else save ptr to current file
	CALL	PRFN		; Print its name
	LD	(NXTFIL),HL	; Save ptr to next file
	CALL	PRINT
	DEFC	' Set to R/'
	LD	HL,(FATT)	; Get attributes
	LD	A,'W'		; Assume R/W
	BIT	7,H		; Is this to be set R/O?
	JR	Z,ATT6		; ..jump if Not to say R/W
	LD	A,'O'		; Set R/O
ATT6:	CALL	CONOUT		; Print the second char
	CALL	PRINT
	DEFC	' and '
	BIT	7,L		; Is this to ba a SYStem file
	JR	NZ,ATT7		; ..jump if so around prompt
	CALL	PRINT
	DEFC	'non-'
ATT7:	CALL	PRINT
	DEFC	'SYS'

	LD	A,(INSPECT)	; Get inspect flag
	OR	A		; Z=no
	POP	HL		; Get ptr to current file
	JR	Z,ATT8		; ..jump if No inspect
	CALL	PRINT		; Else prompt
	DEFC	' (Y/[N]) '
	CALL	CONIN		; Get response
	CP	'Y'		; Is it YES?
	JR	NZ,ATT4		; Advance to next file if not Y
ATT8:	LD	DE,TFCB+1	; Set Destination to the Default FCB
	LD	BC,11		; .move 11 bytes
	LDIR			; ..to desired FCB

	LD	HL,(FATT)	; Get attributes
	EX	DE,HL		; .FCB ptr to HL, Attrs to DE
	DEC	HL		; Pt to sys byte
	DEC	HL
	RES	7,(HL)		; Assume Non-SYStem to start
	BIT	7,E		; Is it SYStem?
	JR	Z,ATT9		; ..jump if Not
	SET	7,(HL)		; Else set to SYS
ATT9:	DEC	HL		; Back down to R/O Byte
	RES	7,(HL)		; Assume R/W to start
	BIT	7,D		; Is R/O Desired?
	JR	Z,ATT9A		; ..jump if Not
	SET	7,(HL)		; Else set to R/O
ATT9A:	LD	DE,TFCB		; Point to Default FCB
	LD	C,B_SATT	; Set attributes
	CALL	BDOS
	JP	ATT4

	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF		;4.0E
	  ENDIF		; proton

;=============================================================================
;		P O P	S H E L L   S T A C K	C O M M A N D
;=============================================================================
; POP the Shell Stack				 Vers 3.0 Cameron W. Cotrill
; This version deals with the case of no stack or 1 entry correctly.

	  IF  spopon
SPOP:
	   IF  BANKED		;4.0E
	LD	HL,BSPOP	;4.0E Point to Banked routine
	JR	DOITV		;4.0E ..and execute (short vector)
	COMMON	/BANK2/		;4.0E
BSPOP:				;4.0E
	   ENDIF		;4.0E
	LD	HL,Z3ENV+21H	; Point to shell stack entry size
	XOR	A
	LD	D,A		; Prep for word value in DE
	LD	A,(HL)		; Get shell entry size
	AND	A
	RET	Z		; Quit now if size == 0
	LD	E,A
	DEC	HL		; Point to number of entries
	LD	A,(HL)		; Get it
	AND	A
	RET	Z		; If no entries
	LD	B,A		; Into B for counter
	LD	L,D
	LD	H,D		; Zero HL
	JR	SPOP2		; Else calc (SHSIZ*(NENTRY-1))

SPOP1:	ADD	HL,DE		; Add size of entry
SPOP2:	DJNZ	SPOP1		; Until multiplied by Entrys-1
	LD	B,H		; HL=bytes to move down in stack
	LD	C,L
	LD	HL,(Z3ENV+1EH)	; Get Base of Shell Stack
	EX	DE,HL		; Length of an entry in HL, SHSTK in DE
	PUSH	HL		; Save length
	ADD	HL,DE		; Point source to second entry in stack
	DEC	A		; Make sure we need to move something
	JR	Z,SPOP3		; If we're not moving
	LDIR			; Move stack down by one entry
SPOP3:	POP	BC		; C=size of entry, B=0
	LD	A,B		; Zero to A
	LD	B,C		; Size to B
SPOP4:	LD	(DE),A		; Clear it
	INC	DE
	DJNZ	SPOP4		; Until last entry clear
	RET
	   IF  BANKED		;4.0E
	CSEG			;4.0E
	   ENDIF		;4.0E
	  ENDIF		; spopon

;=============================================================================
;     E C H O    T E X T    T O    S C R E E N    A N D    P R I N T E R
;=============================================================================
; ECHO - Echo text to console or printer

	  IF  echoon
ECHO:	XOR	A		; Lower case flag setting
	   IF  upcase		; If upper case default
	DEC	A
	   ENDIF
	LD	(INSPECT),A	; Store Case Flag in INSPECT variable

	   IF  BANKED		;4.0E
	LD	HL,BECHO	;4.0E .Point to banked routine
	JR	DOITM7		;4.0E ..and execute (short vector)
	COMMON	/BANK2/		;4.0E
BECHO:				;4.0E
	   ENDIF		;4.0E
	CALL	CRLF		; Start on a New Line
	LD	HL,TBUFF+1	; Point to first character
	CALL	GETCHR		; Get first character (should be blank)
				; If none, exit from routine
	   IF  echolst
	CALL	GETCHR		; Get first char after leading blank
	LD	B,A		; Save first char as list output flag
	CP	'$'		; Print flag?
	JR	Z,ECHO2		; If so, go on
	DEC	HL		; Else backup one character
	   ENDIF	; echolst

; Loop to Echo Chars

ECHO2:	CALL	GETCHR
	   IF  echolst
	CP	FF		; Form feed?
	JR	Z,ECHO3
	   ENDIF	; echolst
	CP	'^'
	JR	NZ,ECHO2A	; Not control character prefix
	CALL	GETCHR		; Get next character
	AND	1FH		; Convert to control character
	JR	ECHO2D		; Echo it

ECHO2A:	CP	CMDCHAR		; Case shift prefix?
	JR	NZ,ECHO2D	; No, normal echo
	CALL	GETCHR		; Get next character
	CP	UCASECHAR	; Up-shift character?
	JR	Z,ECHO2C	; Store non-zero value in case flag

	CP	LCASECHAR	; Lower-case character?
	JR	NZ,ECHO2D	; No, echo the character as is
	XOR	A		; Else, clear case flag
ECHO2C:	LD	(INSPECT),A
	JR	ECHO2		; On to next character

ECHO2D:	CALL	ECHOUT		; Send char
	JR	ECHO2

; Form Feed - Send New Line followed by Form Feed if Printer Output

	   IF  echolst
ECHO3:	LD	A,B		; Check for printer output
	CP	'$'
	JR	NZ,ECHOFF	; Send form feed normally if not printer
	CALL	ECHONL		; Send new line
	LD	A,FF		; Send form feed
	JR	ECHOUT

; Send Form Feed char to Console

ECHOFF:	LD	A,FF		; Get char
	JR	ECHO2D
	   ENDIF	; echolst

; Get a character from the command tail buffer

GETCHR:	LD	A,(HL)		; Get character
	INC	HL		; Point to next one
	OR	A		; Check for end of string
	RET	NZ		; If not end, return
	POP	HL		; Else, clean up stack
			;..fall thru to exit from routine..
; End of Print Loop - Check for Printer Termination
	   IF  NOT echolst
	RET
	   ELSE
	LD	A,B		; Get list mode flag
	CP	'$'
	RET	NZ		; Done if no printer output

; Output a New Line

ECHONL:	LD	A,CR		; Output new line on printer
	CALL	ECHOUT
	LD	A,LF		; Fall thru to echout
	   ENDIF	; Not echolst

; Output char to Printer or Console

ECHOUT:	LD	E,A		; Char in c
	LD	A,(INSPECT)	; Get the Case Flag
	OR	A		; Uppercase selected?
	LD	A,E		; .(get char back)
	CALL	Z,LCASE		; ..convert to Lowercase if needed
	   IF  echolst
	LD	E,A		; Save the character
	LD	A,B		; Check for printer output
	CP	'$'
	LD	A,E		; .(moving char to A)
	JP	NZ,CONOUT	; ..jump if for Console
	    IF  lton
	JP	LOUT		; If List is on, share some code
	    ELSE
	LD	C,B_SLST	; Else direct to Printer
	JP	BDOSSAVE	; .via BDOS Call
	    ENDIF	; lton
	   ELSE			; Not echolst
	JP	CONOUT		; ..and print to CON:
	   ENDIF	; echolst
	  ENDIF		; echoon

	  IF  BANKED		;4.0E
	CSEG			;4.0E
	  ENDIF			;4.0E

; End Z40-7.Z80