*#######################################################################
*		  PROGRAM DEL...Delete File Utility
*
*			Dr. David C. Wilcox
*			DCW Industries, Inc.
*		 5354 Palm Dr., La Canada, CA  91011
*			   818/790-3844
*
*			 January 24, 1986
*#######################################################################
boot	equ	00		*Warm Boot
inchar	equ	01		*Console Input
outchar	equ	02		*Console Output
print	equ	09		*Print String
sfirst	equ	17		*Search for First
snext	equ	18		*Search for Next
delete	equ	19		*Delete File
current	equ	25		*Return Current Disk
setdma	equ	26		*Set DMA Address
null	equ	00		*Ascii NUL
ctrlc	equ	03		*Ascii ETX
tab	equ	09		*Horizontal Tab
lf	equ	10		*Line Feed
cr	equ	13		*Carriage Return
space	equ	32		*Space
upmask	equ	$5f		*Upper Case Mask
bdos	equ	$0002		*BDOS Entry Point
*#######################################################################
*  Special registers:
*
*	a6 = address of first parsed FCB
*	d3 = drive designation
*	d4 = number of file matches counter
*	d5 = R/O bit
*	d6 = SYS bit
*#######################################################################
*
*  Locate FCB (for portability)
*
	link	a6,#0		*Mark stack frame
	move.l	8(a6),a0	*Get base page address
	lea	$5c(a0),a6	*Get address of FCB and save it in a6
*
*  Clear data registers and determine drive specification
*
	jsr	clear
	jsr	getdrv
*
*  Check for no file specified
*
	cmpi.b	#space,1(a6)	*Is 1st char in filespec a space?
	bne	begin
	jsr	delall		*If so, call delall
*
*  Begin search for file name matches
*
begin:
	move.l	#mydma,d1	*===================
	move.w	#setdma,d0	*Set the DMA Address
	trap	#bdos		*===================
	move.l	a6,d1		*Load the FCB
	move.w	#sfirst,d0	*and search for the first match
	trap	#bdos
	cmpi.b	#$ff,d0		*Is there no match?
	beq	quit		*No match if it's zero so quit
*
*  Search for filename matches
*
search:
	mulu	#32,d0		*Adjust for DMA offset of matching entry
	move.l	#mydma,a3	*Point to mydma
	adda.w	d0,a3		*and add the offset
	movea.l	#bufadr,a4	*Point to buffer
	move.l	(a4),a5
	move.w	#32,d1		*Initialize the counter
copy35:
	move.b	(a3)+,(a5)+	*Copy contents of a3 to a5
	subq	#1,d1		*Decrement the counter
	bne	copy35		*and keep looping until it's zero
	move.l	a5,bufadr	*Save buffer address
	addq	#1,d4		*Increment file match counter
	move.l	a6,d1		*=========================
	move.w	#snext,d0	*Search for next occurance
	trap	#bdos		*=========================
	cmpi.b	#$ff,d0		*Is there no match?
	bne	search		*Keep searching until all are found
	movea.l	#buffer,a5	*Point to the original buffer
	move.l	a5,bufadr	*Save buffer address
*
*  Prepare for Deletion
*
prepfil:
	jsr	drivepr		*Display drive identifier
	move.w	#8,d2		*Initialize filename character counter
	movea.l	a5,a4		*Save a5
	adda.l	#1,a5		*Skip drive designation
	jsr	readmem		*Read and display filename
	move.b	#'.',d1		*Send a "." to the console
	jsr	conout
	move.w	#3,d2		*Initialize filetype character counter
	jsr	readmem		*Read and display filetype
	move.b	#space,d1	*Send a space to the console
	jsr	conout
	move.b	#space,d1	*and then send another
	jsr	conout
	movea.l	a4,a5		*Retrieve a5
	adda.l	#9,a5		*and...
	btst	#7,(a5)		*test the R/O bit
	beq	syschk		*If not set, skip to SYS check
	move.b	#$ff,d5		*If file is R/O...store $ff in d5
syschk:
	adda.l	#1,a5
	btst	#7,(a5)		*test the SYS bit
	beq	pretest		*If not set, skip to pretest
	move.b	#$ff,d6		*If file is SYS...store $ff in d6
*
*  Check to see if it's either R/O or SYS
*
pretest:
	or.b	d5,d6		*Or the R/O and SYS bits
	bne.b	mortest		*Additional testing needed if nonzero
	move.b	#tab,d1		*Send a tab to console
	jsr	conout
	jmp	query		*and skip to "Delete..." query
mortest:
	move.b	#'(',d1		*Send left paren to console
	jsr	conout
*
*  Check to see if it's R/O
*
rotest:
	tst.b	d5		*Test for Read Only
	beq	systest		*If not R/O jump to systest
	move.l	#msgro,d1	*Display "R/O"
	jsr	pstring
	move.b	#')',d1		*Send right paren to console
	jsr	conout
	jsr	crlf		*and finish with a cr/lf
	jmp	nexfile		*then skip around delete file logic
*
*  Check to see if it's SYS
*
systest:
	move.l	#msgsys,d1	*Display "SYS"
	jsr	pstring
	move.b	#')',d1		*Send right paren to console
	jsr	conout
	move.b	#tab,d1		*Followed by a tab
	jsr	conout
*
*  Proceed with Deletion
*
query:
	move.l	#msgdel,d1	*Display the "Delete..." query
	jsr	pstring
	move.w	#inchar,d0	*Fetch the keyboard response
	trap	#bdos
	move.b	d0,d2		*Save it
	jsr	crlf		*Send a cr/lf to console
	move.b	d2,d0		*Retrieve the response
	andi.b	#upmask,d0	*Make it upper case
	cmpi.b	#ctrlc,d0	*Check for a ^C
	beq	quit		*If it is...quit
	cmpi.b	#'Y',d0		*Check for a "Y"
	bne	nexfile
	jsr	delfile		*If it is, call the delete file routine
*
*  Prepare for next file
*
nexfile:
	clr.l	d5		*Zero out the R/O
	clr.l	d6		*and SYS bits
	subq	#1,d4		*Decrement file match counter
	beq	quit		*If last file...quit
	movea.l	#bufadr,a4	*Point to buffer
	move.l	(a4),a5
	adda.l	#32,a5		*Add 32 bytes => point to next match
	move.l	a5,bufadr	*Save buffer address
	jmp	prepfil		*Loop back for the next file
*#######################################################################
*                           Subroutines
*#######################################################################
*
*  Clear data registers
*
clear:
	clr.l	d1
	clr.l	d2
	clr.l	d3
	clr.l	d4
	clr.l	d5
	clr.l	d6
	rts
*
*  Send a character to the console
*
conout:
	move.w	#outchar,d0
	trap	#bdos
	rts
*
*  Send a carriage return and a line feed to the console
*
crlf:
	move.b	#cr,d1
	jsr	conout
	move.b	#lf,d1
	jsr	conout
	rts
*
*  Display default delete-file message on the console
*
delall:
	move.l	#msgal1,d1	*Display '*.*..." query
	jsr	pstring
	jsr	drivepr
	move.l	#msgal2,d1
	jsr	pstring
	move.w	#inchar,d0	*Fetch keyboard response
	trap	#bdos
	move.b	d0,d2		*Save it
	jsr	crlf		*Send a cr/lf to console
	move.b	d2,d0		*Retrieve the response
	andi.b	#upmask,d0	*Make it upper case
	cmpi.b	#'Y',d0		*Test for "Y"
	bne.b	abort		*If not...abort
	movea.l	a6,a5		*Point to first character in filename
	addq	#1,a5
	move.w	#11,d2		*Initialize the counter
loop1:
	move.b	#'?',(a5)+	*Make compare file "????????.???"
	subq	#1,d2
	bne.b	loop1
	move.w	#24,d2		*Reinitialize counter
loop2:
	move.b	#null,(a5)+	*Fill the rest of FCB with NULS
	subq	#1,d2
	bne.b	loop2
	rts
*
*  Delete a File
*
delfile:
	movea.l	#bufadr,a0	*Point to buffer
	move.l	(a0),a1
	move.b	(a6),(a1)	*Make sure we have the correct drive
      	move.w	a1,d1		*Load the FCB
	move.w	#delete,d0	*Delete the file
	trap	#bdos
	rts
*
*  Display drive identifier
*
drivepr:
	move.b	d3,d1
	jsr	conout
	move.b	#':',d1
	jsr	conout
	rts
*
*  Determine drive number and make it ascii
*
getdrv:
	move.b	(a6),d1		*Get drive number from FCB
	cmpi.b	#0,d1		*Is it the default drive?
	bne	ascii
	jsr	logged		*If so, get physical drive number
ascii:	addi.b	#64,d1		*Make it ascii
	move.b	d1,d3		*and save it in d3
	rts
*
*  Determine which is the logged drive
*
logged:
	move.w	#current,d0	*Get current drive number
	trap	#bdos
	addq.b	#1,d0		*Increment for consistency with getdrv
	move.w	d0,d1		*and save it in d1 for getdrv
	rts
*
*  Send a String to the Console
*
pstring:
	move.w	#print,d0
	trap	#bdos
	rts
*
*  Quit to CP/M
*
quit:
	cmpi.b	#ctrlc,d0	*Is it a ^C?
	beq	abort		*If so...display abort message
	cmpi.b	#$ff,d0		*Is it a ff hex?
	beq	nomatch		*If so...display "no match..." message
	move.b	#boot,d0	*Otherwise...exit to CP/M
	trap	#bdos
abort:
	move.l	#msgabt,d1	*Display "Program aborted" message
	jsr	pstring
	move.b	#boot,d0	*and exit to CP/M
	trap	#bdos
nomatch:
	move.l	#msgnom,d1	*Display "No match..." message
	jsr	pstring
	move.b	#boot,d0	*and exit to CP/M
	trap	#bdos
*
*  Read a string from memory and display it on the console
*
readmem:
	move.b	(a5)+,d1	*Fetch character from memory
	jsr	conout		*and send it to the console
	subq	#1,d2
	bne	readmem		*and keep looping until counter is zero
	rts
*#######################################################################
*	   	          Console Messages
*#######################################################################
msgdel 	dc.b	tab,'Delete...(y/n)? $'
msgabt 	dc.b	'Program aborted',cr,lf,'$'
msgnom 	dc.b	'No matching files on this disk',cr,lf,'$'
msgal1 	dc.b	'Use  $'
msgal2	dc.b	'*.*  as file match? $'
msgro 	dc.b	'R/O$'
msgsys 	dc.b	'SYS$'
*#######################################################################
*		           Storage Area
*#######################################################################
	even
bufadr  dc.l	buffer
mydma   dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.b	0,0,0,0,0,0,0,0
buffer  dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.b	0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
*#######################################################################
        end