;  PROGRAM:  ERASE
;  VERSION:  5.0
;  DATE:  18 MAY 84
;  AUTHOR:  RICHARD CONN
;  PREVIOUS VERSION:  4.0 (16 JAN 83)
;  PREVIOUS VERSION:  3.3 (6 JAN 83), 3.2 (7 DEC 82)
;  PREVIOUS VERSION:  3.1 (9 NOV 82), 3.0 (18 OCT 82), 2.0 (18 NOV 81)
;  PREVIOUS VERSION:  1.2 (12 APR 81), 1.3 (25 OCT 81), 1.4 (26 OCT 81)
;  PREVIOUS VERSION:  1.0 (14 JUN 80), 1.1 (19 OCT 80)
;
VERS	EQU	53

Z3ENV	DEFL	0FE00H
;
; Version 5.3 -- March 25, 1990 -- Gene Pizzetta
;	Added "A" option to suppress "Erase all files?" question
;	when "*.*" is given as a filespec.  This option is primarily
;	for use in alias scripts and batch files, where you might
;	want to clear a directory without ERASE stopping to ask if
;	you know what you're doing.  Rick Charnes added some nice
;	features in v5.2, but succeeded in badly messing up the display
;	for all prompted erasures.  That has been corrected and the
;	Q (quit) option has been eliminated.  Instead, ^C now aborts
;	ERASE at any prompt.
;
; Version 5.2 -- January 24, 1989 -- Rick Charnes
;	Three changes for v5.2:
;		(1) Now turns off ZEX input while program is running.
;	This is important when ERASE.COM (a) is used in an alias inside
;	a ZEX file under certain circumstances and (b) ERASE.COM requires
;	user input, such as if its I)nspect option is used or if R/O files
;	are encountered.  Otherwise the ZEX script itself would be sent 
;	willy-nilly into the prompt rather than allowing the user to do so.
;		(2)  The ZCPR3 error flag is set if program did not erase
;	any files.  This can be useful in aliases when the correct 
;	execution of the remainder of an alias is dependent upon a 
;	successful erasure.  The error flag is cleared if any files 
;	were successfully erased.
;		(3) ZCPR3 register "0" is set to the number of files
;	successfully erased.  This can also be nice for aliases.  I always
;	liked this concept, for which my inspiration was Jay Sage's doing
;	the same thing with FF.COM, which sets ZCPR3 register 0 to the 
;	number of files successfully found.
;
; Version 5.1A -- December 30, 1987 -- Bruce Morgen
;	Fix option parser as per RENAME32, strip high bit
;	when printing program's actual name for help screen, wheel byte
;	checked before granting "S" or "R" option or help text on those
;	options.
;
; Version 5.1 -- December 21, 1987 -- Bruce Morgen
;	Z80 opcodes, Zilog mnemonics and ZCPR33 Type 3 format.
;	Help message gives correct COMfile name of program.  Following
;	Howard Goldstein's (LX17 & 18) lead, the ZCPR 3.3 parser is used
;	if it's available.

; ERASE command -- Erases files specified in command line.  Command is of
; the form:
;	ERASE dir:filename.typ,... ISRA
; Drive specification is optional.  If I option is given, Inspection of
; each file is performed and the user is given the option to erase the
; file or not.  If S option is given, System files are included in erase
; procedure.  If R option is given, R/O files are erased without prompting.
; If A option is given, user will not be prompted if All files (*.*) are
; selected.

FALSE	EQU	0
TRUE	EQU	NOT FALSE

ESIZE	EQU	16		; SIZE OF DIR ENTRY (FROM SYSLIB DIRQ ROUTINE)

	PUBLIC	COUT		; MAKE SYSLIB USE OUR COUT ROUTINE

	EXTRN	DIRQ		; DIRECTORY PROCESSOR

	EXTRN	Z33CHK		; Version 3.3 test
	EXTRN	Z33FNAME	; ZFNAME, 3.3-style

	EXTRN	Z3INIT		; INIT Z3 ENV
	EXTRN	ZFNAME		; FILE NAME PARSER
	EXTRN	Z3LOG		; LOG INTO Z3 FCB SPEC
	EXTRN	GETEFCB
	EXTRN	GETWHL

	EXTRN	PUTUD		; SAVE CURRENT DU
	EXTRN	GETUD		; GET CURRENT DU
	EXTRN	PHLDC		; PRINT HL AS DECIMAL CHARS
	EXTRN	PHL4HC		; PRINT HL AS HEXADECIMAL CHARS
	EXTRN	EPRINT		; PRINT ROUTINE
	EXTRN	BOUT		; CONSOLE OUTPUT ROUTINE
	EXTRN	CIN		; CONSOLE INPUT ROUTINE
	EXTRN	CAPS		; CAPITALIZE ROUTINE
	EXTRN	CRLF		; NEW LINE ROUTINE
	EXTRN	FILLB		; FILL ROUTINE
	EXTRN	CODEND		; CODE END COMPUTATION ROUTINE
;
	extrn	stopzex		; These added 1/23/89 - rc
	extrn	putreg
	extrn	puter2
;
;  CP/M EQUATES
;
CPM	EQU	0		; WARM BOOT
BDOS	EQU	5		; BDOS ENTRY
FCB	EQU	5CH		; FCB
BUFF	EQU	80H		; INPUT LINE BUFFER
CR	EQU	13		; <CR>
LF	EQU	10		; <LF>
BEL	equ	07		; bell
CTRLC	equ	03		; ^C
	.Z80
;
; Environment Definition
;
	 IF	Z3ENV NE 0
;
; External ZCPR3 Environment Descriptor
;

; TYPE 3 HEADER

; Code modified as suggested by Charles Irvine to function correctly with
; interrupts enabled.  Program will abort with an error message when not
; loaded to the correct address (attempt to run it under CP/M or Z30).

ENTRY:
	JR	START0			; Must use relative jump
	NOP				; Filler
	DB	'Z3ENV',3		; Type-3 environment
Z3EADR:
	DW	Z3ENV			; Filled in by Z33
	DW	ENTRY			; Intended load address

START0:
	LD	HL,0			; Point to warmboot entry
	LD	A,(HL)			; Save the byte there
	DI				; Protect against interrupts
	LD	(HL),0C9H		; Replace warmboot with a return opcode
	RST	0			; Call address 0, pushing RETADDR
					; onto stack
RETADDR:
	LD	(HL),A			; Restore byte at 0
	DEC	SP			; Get stack pointer to point
	DEC	SP			; To the value of RETADDR
	POP	HL			; Get it into HL and restore stack
	EI				; We can allow interrupts again
	LD	DE,RETADDR		; This is where we should be
	XOR	A			; Clear carry flag
	PUSH	HL			; Save address again
	SBC	HL,DE			; Subtract -- we should have 0 now
	POP	HL			; Restore value of RETADDR
	JR	Z,START			; If addresses matched, begin real code

	LD	DE,NOTZ33MSG-RETADDR	; Offset to message
	ADD	HL,DE
	EX	DE,HL			; Switch pointer to message into DE
	LD	C,9
	JP	0005H			; Return via BDOS print string function
NOTZ33MSG:
	DB	'Not Z33+$'		; Abort message if not Z33-compatible

START:
	LD	HL,(Z3EADR)	; Pt to ZCPR3 environment
;
	 ELSE
;
; Internal ZCPR3 Environment Descriptor
;
	MACLIB Z3BASE.LIB
	MACLIB SYSENV.LIB
Z3EADR:
	JP	START
	SYSENV
START:
	LD	HL,Z3EADR	; Pt to ZCPR3 environment
	 ENDIF

;
; Start of Program -- Initialize ZCPR3 Environment
;
	CALL	Z3INIT		; Initialize the ZCPR3 Env and the VLIB Env
;
	LD	(STACK),SP	; GET STACK PTR & SAVE IT
;
; Compute Buffer Locations
;
	CALL	CODEND		; DETERMINE FREE SPACE
	LD	(CMDLNE),HL	; SET PTR TO COMMAND LINE
	LD	DE,100H		; BUFFER SIZE
	ADD	HL,DE		; COMMAND LINE
	LD	(ERAFCB),HL	; FCB FOR ERASE
	ADD	HL,DE
	LD	(DIRBUF),HL	; SET PTR TO DIRECTORY BUFFER
	LD	SP,HL		; SET STACK PTR
;
; Save Location
;
	CALL	PUTUD		; SAVE AWAY CURRENT DU
;
; Version 5.2 mods
;
	call	stopzex		; turn off ZEX
	ld	a,0
	call	puter2		; clear error flag
;
; Print Banner
;
	CALL	EPRINT
	DB	'ERASE  Version '
	DB	VERS/10+'0','.',[VERS MOD 10]+'0'
	DB	' (loaded at ',0
	LD	HL,ENTRY
	CALL	PHL4HC
	CALL	EPRINT
	DB	'h)',0
	LD	A,(FCB+1)	; GET FIRST CHAR OF FILE NAME
	CP	'/'		; OPTION CAUGHT?
	JR	Z,HELP
	CP	' '
	JP	NZ,ECONT

;  PRINT HELP INFORMATION
HELP:	CALL	EPRINT
	DB	CR,LF,'Syntax:',CR,LF,'  ',0
	CALL	GETEFCB
	JR	Z,NOEFCB
	LD	B,8
CNMLP:	INC	HL
	LD	A,(HL)
	AND	7FH
	CP	' '
	CALL	NZ,BOUT
	DJNZ	CNMLP
	JR	HELP2
NOEFCB:	CALL	EPRINT
	DB	'ERASE',0
HELP2:	CALL	EPRINT
	DB	' {dir:}afn.aft{,{dir:}afn.aft{,...}} {{/}options}'
	DB	CR,LF,'Options:'
	DB	CR,LF,'   I   Inspect mode (get user approval).'
	DB	0
	CALL	GETWHL
	jp	Z,RETURN
	CALL	EPRINT
	DB	CR,LF,'   R   Erase R/O files without asking.'
	DB	CR,LF,'   S   Also erase SYS files.'
	db	CR,LF,'   A   Erase all (*.*) files without asking.'
	DB	0

;  RETURN TO OS
RETURN:
	CALL	GETUD		; RESET USER IF NECESSARY
RETX:
	LD	SP,(STACK)	; GET OLD STACK & SET IT
	RET

;  COPY BUFFER INTO TEMP BUFFER
ECONT:
	LD	HL,(CMDLNE)	; PT TO COMMAND LINE
	EX	DE,HL		; ... IN DE
	LD	HL,BUFF+1	; PT TO BUFFER
	LD	BC,80H		; BUFFER SIZE (MAX)
	LDIR			; COPY INTO COMMAND LINE BUFFER

;  EXTRACT FLAGS IF PRESENT
	XOR	A		; SET NO INSPECT, NO R/O, AND NO SYSTEM FILES
	LD	(INSPECT),A
	LD	(READONLY),A
	ld	(NoAsk),a	; NO ASK flag
	LD	A,80H		; SELECT NON-SYS
	LD	(SYSTEM),A
	LD	HL,0		; SET FILE COUNT
	LD	(FILECNT),HL
	LD	HL,(CMDLNE)	; PT TO BUFFER

;  SKIP TO FILE NAME STRING

SBLANK:
	LD	A,(HL)		; SKIP TO NON-BLANK
	CP	' '		; <SP>?
	JR	NZ,SBL1
	INC	HL		; PT TO NEXT CHAR
	JR	SBLANK

;  SKIP TO END OF FILE NAME STRING

SBL1:
	LD	A,(HL)		; SKIP TO <SP> OR EOL
	OR	A		; DONE?
	JP	Z,DSPEC
	CP	' '		; <SP>
	JR	Z,SBL2
	INC	HL		; PT TO NEXT
	JR	SBL1

;  SKIP OVER TRAILING BLANKS

SBL2:
	INC	HL		; Point to character after space
	LD	A,(HL)
	OR	A		; End of command tail?
	JP	Z,DSPEC
	CP	' '		; Another space
	JR	Z,SBL2		; If so, continue skipping


;  CHECK FOR LEADING SLASH ON OPTION AND SKIP IT IF SO
OPT:
	CP	'/'		; OPTION CHAR?
	JR	NZ,OPTION
	INC	HL		; SKIP SLASH

;  PROCESS LIST OF OPTIONS
OPTION:
	LD	A,(HL)		; GET BYTE
	OR	A		; DONE?
	jp	Z,DSPEC
	INC	HL		; PT TO NEXT CHAR
	CP	' '		; SKIP OVER SPACES
	JR	Z,OPTION
	CP	'/'		; IF OPTION LETTER, OBVIOUS ERROR, SO HELP
	JP	Z,HELP
	CP	'I'		; INSPECT?
	JR	Z,OPTINS
	CP	'R'		; READ/ONLY?
	JR	Z,OPTRO
	cp	'A'		; DON'T ASK?
	jr	z,OptAsk
	CP	'S'		; SYSTEM FILES?
	JP	NZ,HELP

;  SET SYS SELECTION
	PUSH	AF
	CALL	GETWHL
	JR	Z,NOWHL
	POP	AF
	LD	A,0C0H		; SET FOR SYS AND NON-SYS FILES
	LD	(SYSTEM),A
	JR	OPTION

;  SET INSPECT OPTION
OPTINS:
	LD	A,0FFH		; INSPECT
	LD	(INSPECT),A
	JR	OPTION

;  Set DON'T ASK option
OptAsk:
	ld	a,0FFh		; don't ask
	ld	(NoAsk),a
	jr	OPTION

;  SET R/O OPTION
OPTRO:
	PUSH	AF
	CALL	GETWHL
	JR	Z,NOWHL
	POP	AF
	LD	A,0FFH		; SET R/O
	LD	(READONLY),A
	JR	OPTION

NOWHL:	LD	A,'"'
	CALL	BOUT
	POP	AF
	CALL	BOUT
	CALL	EPRINT
	DB	'" option denied, Wheel privileges required.',CR,LF,0
	jp	OPTION

;  EXTRACT DISK, USER, AND FILE NAME INFORMATION
DSPEC:
	LD	HL,(CMDLNE)	; PT TO BEFORE FIRST BYTE
	DEC	HL		; PT TO BEFORE FIRST BYTE FOR FOLLOWING INC
DSPEC0:
	INC	HL		; PT TO BYTE
	LD	A,(HL)		; GET BYTE
	OR	A		; DONE?
	JP	Z,HELP
	CP	' '		; <SP>?
	JR	Z,DSPEC0
;
;  MAJOR REENTRY POINT WHEN FILE SPECS ARE SEPARATED BY COMMAS
;    HL PTS TO FIRST BYTE OF NEXT FILE SPEC
;
DSPEC1:
	CALL	GETUD		; RETURN HOME
	LD	DE,FCB		; PT TO FCB IN DE, PT TO FIRST CHAR OF FILE NAME IN HL
	CALL	PARSIT		; EXTRACT FILE NAME INTO FCB, AND GET DISK AND USER
	LD	(NEXTCH),HL	; SAVE PTR TO DELIMITER WHICH ENDED SCAN
	LD	HL,FCB+1	; SEE IF FILE NAME IS ALL WILD
	LD	B,11		; 11 BYTES
WTEST:
	LD	A,(HL)		; GET BYTE
	INC	HL		; PT TO NEXT
	CP	'?'		; WILD?
	JR	NZ,NOWILD
	DJNZ	WTEST		; COUNT DOWN
	LD	A,(INSPECT)	; INSPECT?
	OR	A		; 0=NO
	JR	NZ,NOWILD
	ld	a,(NoAsk)	; check DON'T ASK flag
	or	a		; 0=yes, ask
	jr	nz,NOWILD
	CALL	EPRINT
	DB	CR,LF,'Erase All Files? ',0
	CALL	CIN		; GET RESPONSE
	CALL	CAPS		; CAPITALIZE
	CALL	BOUT		; ECHO
	CP	'Y'		; YES?
	JR	Z,NOWILD
	CALL	EPRINT
	DB	CR,LF,'Aborting',0
	JP	RETX
NOWILD:
	LD	DE,FCB		; PT TO FCB
	CALL	Z3LOG		; LOG INTO DIRECTORY

;  LOAD DIRECTORY AND ERASE FILES
ERASE:
	LD	HL,(DIRBUF)	; PT TO DIR BUFFER
	LD	A,(SYSTEM)	; GET SYS/NON-SYS FLAGS
	LD	DE,FCB		; PT TO FCB
	CALL	DIRQ		; LOAD DIR, SELECT FILES, PACK, AND ALPHABETIZE

;  ERASE DIR FILES; HL PTS TO FIRST FILE, BC=FILE COUNT
	CALL	ERAFILES

;  CHECK FOR NEXT FILE SPEC
	LD	HL,(NEXTCH)	; GET PTR
	LD	A,(HL)		; GET DELIM
	CP	','		; ANOTHER FILE?
	JR	NZ,ERADONE
	INC	HL		; PT TO CHAR AFTER COMMA
	JR	DSPEC1		; CONTINUE PROCESSING

;  ERASE COMPLETE -- PRINT COUNT AND EXIT
ERADONE:
	CALL	PRCOUNT		; PRINT FILE COUNT
	JP	RETURN

;  ERASE SELECTED FILES
ERAFILES:
	LD	A,B		; CHECK FOR ANY FILES LOADED
	OR	C
	RET	Z

;  PRINT FILE NAME
ERAFLP:
	PUSH	BC		; SAVE ENTRY COUNT
	CALL	CRLF		; NEW LINE
	PUSH	HL		; SAVE PTR TO FCB
	INC	HL		; PT TO FILE NAME
	LD	B,8		; PRINT NAME
	CALL	PRNT
	LD	A,'.'		; DECIMAL
	CALL	BOUT
	LD	B,3		; PRINT TYPE
	CALL	PRNT
	POP	HL		; GET PTR

;  CHECK FOR INSPECTION AND INSPECT IF SET
	LD	A,(INSPECT)	; GET FLAG
	OR	A		; 0=NO
	JR	Z,ERAIT

;  PROMPT USER FOR ERASE
	CALL	ERAQ		; ERASE QUESTION
	CP	CTRLC		; QUIT?
	JR	Z,QUIT
	CP	'Y'		; YES?
	JR	Z,ERAIT

;  DON'T ERASE FILE
ERANO:
	CALL	EPRINT
	DB	'  NOT Erased',0
	JP	ERATEST

;  PROMPT USER FOR ERASE
ERAQ:
	CALL	EPRINT		; PRINT PROMPT
	DB	'  Erase (Y/[N])? ',0
	CALL	CIN		; GET RESPONSE
	CALL	CAPS		; CAPITALIZE
	cp	'Y'
	jr	z,cout
	cp	CtrlC		; quit?
	ret	z
	ld	a,'N'
COUT:	JP	BOUT		; ECHO

;  QUIT ERASE PROGRAM
QUIT:
	CALL	EPRINT
	db	'^C',0
	CALL	PRCOUNT		; PRINT COUNT OF FILES ERASED
	JP	RETURN

;  ERASE FILE
ERAIT:
	PUSH	HL
	LD	DE,9		; PT TO R/O ATTRIBUTE
	ADD	HL,DE
	LD	A,(HL)		; GET R/O ATTRIBUTE
	POP	HL		; RESTORE PTR
	AND	80H		; R/O?
	JR	Z,ERAIT1	; R/W - PROCEED
	LD	A,(READONLY)	; GET R/O ERASE FLAG
	OR	A		; 0=QUERY
	JR	NZ,ERAIT0	; ERASE WITHOUT QUESTION IF FLAG SET
	CALL	EPRINT		; NOTIFY USER AND PROMPT
	DB	BEL,'  File is R/O,',0
	CALL	ERAQ		; ASK QUESTION
	CP	CTRLC		; QUIT?
	JR	Z,QUIT
	CP	'Y'		; ERASE R/O
	JR	NZ,ERATEST	; DO NOT ERASE IF NOT YES

;  ERASE R/O FILE
ERAIT0:
	PUSH	HL		; SAVE PTR TO FILE ENTRY
	LD	DE,9		; PT TO R/O ATTRIBUTE
	ADD	HL,DE
	LD	A,(HL)		; GET ATTRIBUTE
	AND	7FH		; MAKE R/W
	LD	(HL),A
	POP	HL		; GET PTR TO FCB
	PUSH	HL		; SAVE PTR AGAIN
	EX	DE,HL		; DE PTS TO FCB
	XOR	A		; MAKE SURE CURRENT DISK IS SELECTED
	LD	(DE),A
	LD	C,30		; SET FILE ATTRIBUTES
	CALL	BDOS
	POP	HL

;  ERASE R/W FILE
ERAIT1:
	PUSH	HL		; SAVE PTR TO FILE NAME TO ERASE
	INC	HL		; PT TO FIRST BYTE OF NAME
	PUSH	HL		; SAVE HL
	LD	HL,(ERAFCB)	; SET UP FCB
	EX	DE,HL		; ... IN DE
	POP	HL		; GET HL
	PUSH	DE		; SAVE PTR
	XOR	A		; A=0
	LD	(DE),A		; CURRENT DISK
	INC	DE		; PT TO FIRST CHAR
	LD	BC,11		; COPY 11 BYTES
	LDIR			; COPY HL TO DE FOR 11 BYTES
	EX	DE,HL		; HL PTS TO REST OF FCB
	LD	B,24		; FILL REST OF FCB WITH ZEROES
	XOR	A		; A=0
	CALL	FILLB
	POP	DE		; GET PTR
	LD	C,19		; DELETE FILE
	CALL	BDOS
	CALL	EPRINT
	DB	'    Erased',0
	LD	HL,(FILECNT)	; INCREMENT COUNT
	INC	HL
	LD	(FILECNT),HL
	POP	HL		; GET PTR TO DIRECTORY ENTRY

;  PT TO NEXT ENTRY
ERATEST:
	LD	DE,ESIZE	; PT TO NEXT ENTRY
	ADD	HL,DE
	POP	BC		; GET COUNT
	DEC	BC		; COUNT DOWN
	LD	A,B		; CHECK FOR ZERO
	OR	C
	JP	NZ,ERAFLP

;  RETURN TO CALLER
	RET
;
;
;  PRINT CHARS PTED TO BY HL FOR B BYTES
;
PRNT:
	LD	A,(HL)		; GET CHAR
	CALL	BOUT
	INC	HL		; PT TO NEXT
	DJNZ	PRNT		; COUNT DOWN
	RET

;
;  PRINT COUNT OF NUMBER OF FILES ERASED
;
PRCOUNT:
	CALL	CRLF		; NEW LINE
	LD	HL,(FILECNT)	; GET COUNT
	ld	b,0		; we'll be setting ZCPR3 register "0"
	LD	A,L		; CHECK FOR NONE (and prepare for PUTREG - rc)
	call	putreg
	OR	H
	JR	Z,PRNO
	CALL	PHLDC		; PRINT DECIMAL COUNT
	JR	PRMS
PRNO:
	ld	a,0ffh		; prepare for PUTER2
	call	puter2		; set ZCPR3 error flag if no files erased
	CALL	EPRINT
	DB	'No',0
PRMS:
	LD	HL,(FILECNT)	; 1 FILE ERASED?
	LD	A,H		; HIGH ZERO?
	OR	A
	JR	NZ,PRMULT
	LD	A,L		; LOW ONE?
	CP	1
	JR	Z,PRSING
PRMULT:
	CALL	EPRINT
	DB	' Files Erased',0
	RET
PRSING:
	CALL	EPRINT
	DB	' File  Erased',0
	RET

PARSIT:
	CALL	Z33CHK
	JP	Z,Z33FNAME
	XOR	A
	JP	ZFNAME

	DSEG
;
;  BUFFERS
;
INSPECT:
	DS	1		; INSPECT FLAG (0=NO, 0FFH=YES)
SYSTEM:
	DS	1		; SYSTEM FLAG (0=NO, 80H=YES)
READONLY:
	DS	1		; READ/ONLY FLAG (0=QUERY FOR R/O, 0FFH=DON'T)
NoAsk:
	ds	1		; DON'T ASK flag (0=query *.*, 0FFh=don't)
USER:
	DS	1		; NEW USER, OR 0FFH IF NO CHANGE
CURUSER:
	DS	1		; CURRENT USER NUMBER
NEXTCH:
	DS	2		; PTR TO NEXT CHAR IN MULTIFILE COMMAND LINE
FILECNT:
	DS	2		; COUNT OF NUMBER OF FILES ERASED
ERAFCB:
	DS	2		; PTR TO FCB FOR ERASE
CMDLNE:
	DS	2		; PTR TO COMMAND LINE
DIRBUF:
	DS	2		; PTR TO DIRECTORY BUFFER
STACK:
	DS	2		; OLD STACK PTR

	END