;
; Program:  CLEANDIR
; Derivation:  SAP 3.8 (see following history for authors)
; Derivation By:  Richard Conn
; Version: 1.0
; Date:  20 June 84
;
vers	equ	10
z3env	equ	0f400h

;
;  SYSLIB and Z3LIB References
;
	ext	z3init,z3log
	ext	eprint,cout
	ext	codend

;
; Environment Definition
;
	if	z3env ne 0
;
; External ZCPR3 Environment Descriptor
;
	jmp	start
	db	'Z3ENV'	;This is a ZCPR3 Utility
	db	1	;External Environment Descriptor
z3eadr:
	dw	z3env
start:
	lhld	z3eadr	;pt to ZCPR3 environment
;
	else
;
; Internal ZCPR3 Environment Descriptor
;
	MACLIB	Z3BASE.LIB
	MACLIB	SYSENV.LIB
z3eadr:
	jmp	start
	SYSENV
start:
	lxi	h,z3eadr	;pt to ZCPR3 environment
	endif

;
; Start of Program -- Initialize ZCPR3 Environment
;
	call	z3init	;initialize the ZCPR3 Environment

; v3.8 SORT AND PACK CP/M DISK DIRECTORY - 10/16/83
;
; THIS PROGRAM READS THE DISK DIRECTORY TRACKS, SORTS THEM ALPHABETICALLY
; THEN REPLACES THEM ON THE DISK.  ALL UNUSED OR ERASED AREAS ON THE DIR-
; ECTORY TRACK ARE REFORMATTED WITH CONTINUOUS 'E5' CHARACTERS.  (THIS
; ERASES PREVIOUS FILE NAMES WHICH HAVE BEEN DEACTIVATED.)  SORTING THE
; DIRECTORY IN THIS MANNER OFFERS MANY ADVANTAGES.  SOME OF THEM ARE:
;
;	1)  ALLOWS 'DIR' TO SHOW AN ALPHABETIZED LISTING
;	2)  ELIMINATES POTENTIAL PROBLEMS WITH "UNERASE" PROGRAMS
;	3)  SPEEDS UP ACCESS VIA 'SD' AND OTHER SPECIAL PROGRAMS
;	4)  ASSISTS ON WORKING DIRECTLY ON THE DISK WITH 'DUU', ETC.
;	5)  REMOVES FILES FROM THE DISK SOMEBODY ELSE COULD RECOVER
;
;				- Notes by Irv Hoff W6FFC
;
; 1977	Written by L. E. Hughes.  Modified extensively since by Bruce
;	Ratoff, Keith Petersen, James Prest, Ron Fowler, Frank Gaude,
;	Irv Hoff and likely others.
;
; 10/16/83 Now using a Shell-Metzner sort which speeds the sorting time
;	   considerably, especially on large directories. (SFK)
;
; 07/27/83 Shows an error flag for MP/M and CP/M+ both.  Rewrites dir-
;	   tory even if previously sorted, to insure erased programs at
;   v3.7   end of directory are properly cleared.
;					- Irv Hoff
;                                                              
TRUE	EQU	0FFH
FALSE	EQU	0
;
BDOS	EQU	5
CR	EQU	0DH
DPBLEN	EQU	15		;SIZE OF CP/M2 DISK PARAMETER BLOCK
FCB	EQU	5CH
FCB2	EQU	6CH
GETDSK	EQU	25		;BDOS "GET DISK #" FUNCTION
LF	EQU	0AH
SELDRV	EQU	14		;SELECT DRIVE
;.....
; 
;
; OBTAIN BIOS VECTORS
;
VECTRS:
	JMP	GETVEC
;
	DS	53		;ROOM FOR JUMP VECTORS
;
WBOOT	EQU	VECTRS+3	;DO NOT CHANGE THESE EQUATES
CSTS	EQU	VECTRS+6
CI	EQU	VECTRS+9
CO	EQU	VECTRS+12
LO	EQU	VECTRS+15
PO	EQU	VECTRS+18
RI	EQU	VECTRS+21
HOME	EQU	VECTRS+24
SELDSK	EQU	VECTRS+27
SETTRK	EQU	VECTRS+30
SETSEC	EQU	VECTRS+33
SETDMA	EQU	VECTRS+36
READ	EQU	VECTRS+39
WRITE	EQU	VECTRS+42
LSTS	EQU	VECTRS+45	;ONLY IN CP/M2
SECTRN	EQU	VECTRS+48	;ONLY IN CP/M2
;
;  GET BIOS VECTORS
;
GETVEC:
	LXI	D,WBOOT
	LHLD	1
	MVI	B,53
	CALL	MOVE
;
;  PROGRAM STARTS HERE
;
	LXI	H,0
	DAD	SP		;GET ADDRESS OF CP/M STACK
	SHLD	STACK		;STORE IT SO WE CAN GO BACK TO IT
	CALL	CODEND		;DETERMINE FREE SPACE
	LXI	D,80H		;ALLOW 80H BYTES FOR STACK
	SHLD	BUF		;SET BUFFER ADDRESS
	SPHL			;SET TOP OF STACK
	XRA	A		;SET NO REVERSE OF USER AREAS
	STA	REVERSE
   	CALL	EPRINT		;PRINT MSG:
	DB	'CLEANDIR, Version '
	DB	(vers/10)+'0','.',(vers mod 10)+'0'
	DB	0
	LDA	FCB+1		;CHECK FOR HELP REQUEST
	CPI	'/'		;ANY OPTION MEANS HELP
	JZ	HELP
	CPI	'D'		;SELECT DESCENDING ORDER?
	JZ	DESC
	LDA	FCB2+1		;CHECK FOR OPTION CHAR
	CPI	'D'		;DESCENDING ORDER OF USER AREAS?
	JNZ	SAP
DESC:
	MVI	A,0FFH		;ENABLE REVERSE
	STA	REVERSE
	JMP	SAP
;
;  PRINT HELP MESSAGE
;
HELP:
	CALL	EPRINT
	DB	CR,LF,'Syntax:'
	DB	CR,LF,'  CLEANDIR dir: o'
	DB	CR,LF,'Options:'
	DB	CR,LF,'  D - sort in Descending Order (users and files)'
	DB	CR,LF,'Note:'
	DB	CR,LF,'  Only disk ref is used in dir: form'
	DB	0
	JMP	EXIT1
;
;  MAIN PROGRAM ROUTINE
;
SAP:
	CALL	SETUP
	CALL	RDDIR
	CALL	CLEAN
	CALL	SORT
	CALL	PACK
	CALL	WRDIR
	CALL	EPRINT
	DB	'Done',0
	JMP	EXIT
;
;  	SUBROUTINES
;
CLEAN:
	LXI	H,0		;I = 0
;
CLNLOP:
	SHLD	I
	CALL	INDEX		;HL = BUF + 16 * I
	MOV	A,M		;JUMP IF THIS IS A DELETED FILE
	CPI	0E5H
	JZ	FILLE5
	LXI	D,12
	DAD	D		;HL = HL + 12
	MOV	A,M		;CHECK EXTENT FIELD
	ORA	A
	JNZ	CLBUMP		;SKIP IF NOT EXTENT ZERO
	INX	H		;POINT TO RECORD COUNT FIELD
	INX	H
	MOV	A,M		;GET S2 BYTE (EXTENDED RC)
	ANI	0FH		;  FOR CPM2, 0 FOR CPM1
	MOV	E,A
	INX	H
	MOV	A,M		;CHECK RECORD COUNT FIELD
	ORA	E
	JNZ	CLBUMP		;JUMP IF NON-ZERO
	LHLD	I		;CLEAR ALL 32 BYTES OF
	CALL	INDEX		;  DIRECTORY ENTRY TO E5
	INX	H
	MOV	A,M		;GET FIRST CHAR OF FILENAME
	DCX	H		;  WARD CHRISTENSONS CAT PGMS
	CPI	'-'		;  HAVE DISKNAME OF ZERO LENGTH
	JZ	CLBUMP		;  THAT START WITH '-', DON'T DELETE
;
FILLE5:
	MVI	C,32		;NUMBER OF BYTES TO CLEAR
;
FILLOP:
	MVI	M,0E5H		;MAKE IT ALL E5'S
	INX	H
	DCR	C
	JNZ	FILLOP
;
CLBUMP:
	LHLD	DRM		;GET COUNT OF FILENAMES
	INX	H
	XCHG
	LHLD	I		;OUR CURRENT COUNT
	INX	H
	PUSH	H
	CALL	SUBDE		;SUBTRACT
	POP	H
	JC	CLNLOP		;LOOP TILL ALL CLEANED
	RET
;
DODIR:
	STA	WRFLAG
	LHLD	SYSTRK
	CALL	DOTRAK		;SET THE TRACK
	LXI	H,0
	SHLD	SECTOR
	LHLD	DRM		;NUMBER OF DIR ENTRIES
	INX	H		;RELATIVE TO 1
	CALL	ROTRHL		;DIVIDE BY 4
	CALL	ROTRHL		;  TO GET SECTOR COUNT
	SHLD	DIRCNT
	LHLD	BUF
	SHLD	ADDR		;FOR DMA ADDRESS
;
DIRLOP:
	LHLD	SECTOR		;GET SECTORS PER TRACK
	INX	H
	XCHG
	LHLD	SPT		;CURRENT SECTOR
	CALL	SUBDE		;  SECTOR - SPT
	XCHG
	JNC	NOTROV
;
; TRACK OVERFLOW, BUMP TO NEXT
;
	LHLD	TRACK
	INX	H
	CALL	DOTRAK
	LXI	H,1		;REWIND SECTOR NUMBER
;
NOTROV:
	CALL	DOSEC		;SET CURRENT SECTOR
	LHLD	ADDR
	MOV	B,H		;SET UP DMA ADDRESS
	MOV	C,L
	CALL	SETDMA
	LDA	WRFLAG		;TIME TO FIGURE OUT
	ORA	A		;  IF WE ARE READING
	JNZ	DWRT		;  OR WRITING
;
;
; READ
;
	CALL	READ
	ORA	A		;TEST FLAGS ON READ
	JNZ	RERROR		;NZ=ERROR
	JMP	MORE		;GOOD READ, GO DO MORE
;
; TRACK AND SECTOR UPDATE ROUTINES
;
DOTRAK:
	SHLD	TRACK
	MOV	B,H
	MOV	C,L
	CALL	SETTRK
	RET
DOSEC:
	SHLD	SECTOR
	MOV	B,H
	MOV	C,L
	LHLD	SECTBL
	XCHG
	DCX	B
	CALL	SECTRN
	MOV	B,H
	MOV	C,L
	CALL	SETSEC
	RET
;
; WRITE
;
DWRT:
	MVI	C,1		;FOR CPM/2 DEBLOCKING BIOS'S
	CALL	WRITE
	ORA	A		;TEST FLAGS ON WRITE
	JNZ	WERROR		;NZ=BAD DIRECTORY WRITE
	JMP	MORE
;
; Exit Program
;
EXIT:
	LDA	NOBOOT		;SEE IF BOOT IS NEEDED
	ORA	A
	JNZ	EXIT1		;FLAG IS SET IF ALREADY ALPHABETIZED
	JMP	0000H		;A REWRITTEN DIRECTORY NEEDS A WARM BOOT
;
EXIT1:
	LHLD	STACK		;GET ADDRESS OF ORIGINAL CP/M STACK
	SPHL			;RESET STACK ADDRESS
	RET
;
INDEX:
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	XCHG
	LHLD	BUF	;GET ADDRESS OF BUF
	XCHG
	DAD	D
	RET
;
; GOOD READ OR WRITE
;
MORE:
	LHLD	ADDR		;BUMP DMA ADRS FOR NEXT PASS
	LXI	D,80H
	DAD	D
	SHLD	ADDR
	LHLD	DIRCNT		;COUNTDOWN ENTRIES
	DCX	H
	SHLD	DIRCNT
	MOV	A,H		;TEST FOR ZERO LEFT
	ORA	L
	JNZ	DIRLOP		;LOOP TILL ZERO
;
;
; DIRECTORY I/O DONE, RESET DMA ADDRESS
;
	LXI	B,80H
	CALL	SETDMA
	RET
;
; MOVE UTILITY SUBROUTINE
;
MOVE:
	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	MOVE
	RET
;
; PACK DIRECTORY
;
PACK:
	LXI	H,0		;I = 0
;
PACK1:
	SHLD	I
	CALL	INDEX		;HL = BUF + 16 * I
	LXI	D,9
	DAD	D		;HL = HL + 9
	MOV	A,M		;JUMP IF FILETYPE NOT 'X$$'
	SUI	'0'		;  WHERE 0.LE.X.LE.9
	JC	PACK2
	CPI	10
	JNC	PACK2
	STA	J
	INX	H
	MOV	A,M
	CPI	'$'
	JNZ	PACK2
	INX	H
	MOV	A,M
	CPI	'$'
	JNZ	PACK2
	INX	H		;SET EXTENT NUMBER TO X
	LDA	J
	MOV	M,A
	DCX	H		;SET FILETYPE TO '$$$'
	MVI	M,'$'
	DCX	H
	MVI	M,'$'
	DCX	H
	MVI	M,'$'
;
PACK2:
	LHLD	I		;I = I + 1
	INX	H
	XCHG
	LHLD	DRM
	INX	H
	XCHG
	PUSH	H
	CALL	SUBDE
	POP	H		;LOOP UNTIL I > DRM
	JC	PACK1
	RET
;
; READ AND WRITE DIRECTORY ROUTINES
;
RDDIR:
	CALL	EPRINT
	DB	' --> Reading, ',0
	XRA	A
	STA	NOBOOT		;ZERO THE FLAG
	JMP	DODIR		;ZERO THE WRITE FLAG FOR NOW
;
; COME HERE IF WE GET A READ ERROR
;
RERROR:
	CALL	EPRINT		;PRINT:
	DB	' READ ERROR - No Change Made',0
	JMP	EXIT
;
; DIVIDE HL BY 2
;
ROTRHL:
	ORA	A		;CLEAR CARRY
	MOV	A,H
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	RET
;
; SETUP FOR SELECTING DRIVE AND LOADING DISK PARM BLOCK
;
SETUP:
	LXI	D,FCB
	CALL	Z3LOG		;LOG INTO DISK SPECIFIED BY USER
	MVI	C,GETDSK	;OTHERWISE GET CURRENT DEFAULT DRIVE
	CALL	BDOS		;SO QUERY 'BDOS' FOR DRIVE
	MOV	C,A		;PREP FOR OBTAINING DPB
	CALL	EPRINT
	DB	CR,LF,' Disk ',0
	MOV	A,C		;GET DISK NUMBER
	ADI	'A'		;CONVERT TO ASCII
	CALL	COUT
	CALL	SELDSK
;
; GET CP/M 2.2 DPB DATA
;
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	XCHG
	SHLD	SECTBL
	XCHG
	LXI	D,8		;OFFSET TO DPB WITHIN HEADER
	DAD	D		;RETURNED BY SELDSK IN CPM2
	MOV	A,M		;GET ADRS OF DPB
	INX	H
	MOV	H,M
	MOV	L,A
	LXI	D,DPB		;POINT TO DEST: OUR DPB
	MVI	B,DPBLEN
	CALL	MOVE
	RET
;
; SORT THE DIRECTORY
;
SORT:
	CALL	EPRINT
	DB	'Sorting (',0
	LDA	REVERSE		;INDICATE ASC OR DSC
	ORA	A		;0=ASC
	JZ	SORTASC
	CALL	EPRINT
	DB	'Descending',0
	JMP	SORTDO
SORTASC:
	CALL	EPRINT
	DB	'Ascending',0
;
; SHELL-METZNER SORT
;
SORTDO:
	CALL	EPRINT
	DB	' Order), ',0
	LHLD	I
	SHLD	SNUMRECW
	LHLD	BUF
	SHLD	SSTADR
	PUSH	H		;  AND SAVE IT
	LXI	H,32
	SHLD	SRECLEN
	PUSH	H		;  AND SAVE IT
;
; NOW DIVIDE # OF FIELDS BY 2
;
DIVIDE:
	LHLD	SNUMRECW	;GET VALUE
	CALL	ROTRHL
	SHLD	SNUMRECW	;SAVE RESULT
	MOV	A,L		;IF SNUMRECW<>0
	ORA	H		;  THEN
	JNZ	NOTDONE		;    NOT DONE
;
; ALL FIELDS SORTED
;
	POP	B		;CLEAN UP STACK
	POP	D
	RET
;
NOTDONE:
	XCHG
	LHLD	I
	MOV	A,L
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	SHLD	SRECLEN
	LXI	H,1
	SHLD	SSORTV1
	SHLD	SSTADR
	DCR	L
	POP	B
	PUSH	B
NDONE1:
	DAD	D
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	NDONE1
	SHLD	SSORTV2
	XCHG
	POP	B
	POP	H
	PUSH	H
	PUSH	B
NDONE2:
	SHLD	SSORTV4
	SHLD	SSORTV3
	XCHG
	DAD	D
	XCHG
COMPARE:
	POP	B
	PUSH	B
COMPAR1:
	LDAX	D
	ANI	7FH
	PUSH	B
	MOV	C,A
	MOV	A,M
	ANI	7FH
	MOV	B,A
	MOV	A,C
	SUB	B
	POP	B
	JNZ	NOTEQU
	INX	H
	INX	D
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	COMPAR1
	JMP	NOSWITCH
;
; THE CONDITION AT NOTEQU: HAS TO
; BE CHANGED FOR DESCENDING SORT -- IF REVERSE=0, JNC TO NOSWITCH, ELSE
; JC TO NOSWITCH
;
NOTEQU:
	PUSH	PSW	;SAVE CONDITION
	LDAX	D	;GET (DE)
	CPI	0E5H	;IF ERASED, SELECT ASCENDING
	JZ	ASCENDING
	MOV	A,M	;GET (HL)
	CPI	0E5H	;IF ERASED, SELECT ASCENDING
	JZ	ASCENDING
	LDA	REVERSE	;DESCENDING SORT?
	ORA	A	;0=NO
	JZ	ASCENDING
	POP	PSW	;GET CONDITION FOR DESCENDING SORT
	JC	NOSWITCH
	JMP	SWITCH
ASCENDING:
	POP	PSW	;GET CONDITION FOR ASCENDING SORT
	JNC	NOSWITCH
SWITCH:
	PUSH	B
	MOV	B,M
	LDAX	D
	MOV	M,A
	MOV	A,B
	STAX	D
	INX	H
	INX	D
	POP	B
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	SWITCH
	LHLD	SNUMRECW
	MOV	A,H
	CMA
	MOV	D,A
	MOV	A,L
	CMA
	MOV	E,A
	LHLD	SSORTV1
	DAD	D
	JNC	NOSWITCH
	INX	H
	SHLD	SSORTV1
	LHLD	SSORTV3
	XCHG
	LHLD	SSORTV2
	MOV	A,E
	SUB	L
	MOV	L,A
	MOV	A,D
	SBB	H
	MOV	H,A
	SHLD	SSORTV3
	JMP	COMPARE
;
NOSWITCH:
	LHLD	SSTADR
	INX	H
	SHLD	SSTADR
	SHLD	SSORTV1
	XCHG
	LHLD	SRECLEN
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	JC	DIVIDE
	LHLD	SSORTV4
	POP	D
	PUSH	D
	DAD	D
	XCHG
	LHLD	SSORTV2
	XCHG
	JMP	NDONE2
;
; UTILITY SUBTRACTION SUBROUTINE...
; HL=HL-DE
;
SUBDE:
	MOV	A,L
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	RET
;.....
;
;
WRDIR:
	CALL	EPRINT
	DB	'Writing, ',0
	MVI	A,1
	JMP	DODIR
;
; COME HERE IF WE GET A WRITE ERROR
;
WERROR:
	CALL	EPRINT		;PRINT:
	DB	' WRITE ERROR - Directory Left in UNKNOWN Condition',0
	JMP	EXIT
;
; DATA AREA
;
ADDR:
	DS	2
BUF:
	DS	2
DIRCNT:
	DS	2
I:
	DS	2
J:
	DS	2
MAPPTR:
	DS	2
NOBOOT:
	DS	1
NOSWAP:
	DS	1
REVERSE:
	DS	1
SECTBL:
	DS	2
SECTOR:
	DS	2
TRACK:
	DS	2
WRFLAG:
	DS	1
SRECLEN:
	DS	2
SSTADR:
	DS	2
SSORTV1:
	DS	2
SSORTV2:
	DS	2
SSORTV3:
	DS	2
SSORTV4:
	DS	2
SNUMRECW:
	DS	2
;
; DISK PARAMETER BLOCK:
;
DPB:
SPT:
	DS	2
BSH:
	DS	1
BLM:
	DS	1
EXM:
	DS	1
DSM:
	DS	2
DRM:
	DS	2
AL0:
	DS	1
AL1:
	DS	1
CKS:
	DS	2
SYSTRK:
	DS	2
;
STACK:
	DS	2		;SPACE FOR OLD STACK ADDRESS
;
	END
;