; 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
GETDSK:	EQU	25		;BDOS "GET DISK #" FUNCTION
LF:	EQU	0AH
SELDRV: EQU	14		;SELECT DRIVE
VERNO:	EQU	12		;PROVIDES CP/M VERSION NUMBER
;.....
; 
;
	ORG	100H
;
	JMP	VECTRS		;JMP AROUND IDENTIFICATION MSG
;
;
; 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
;.....
;
;
GETVEC: LXI	D,WBOOT
	LHLD	1
	MVI	B,53
	CALL	MOVE
;
;=======================================================================
;
;			PROGRAM STARTS HERE
;
;=======================================================================
;
;
START:	LXI	H,0
	DAD	SP		;GET ADDRESS OF CP/M STACK
	SHLD	STACK		;STORE IT SO WE CAN GO BACK TO IT
	LXI	SP,STACK	;NOW USE OUR OWN STACK
   	CALL	ILPRT		;PRINT MSG:
	DB	CR,LF,'SORT AND PACK DIRECTORY v3.8 10/16/83',CR,LF,0
	MVI	C,VERNO		;CHECK FOR CP/M VER 2.2
	CALL	BDOS
	MOV	A,H		;H=1 FOR MPM
	ORA	A
	JNZ	MPMYES		;EXIT IF MPM, WE CAN'T USE IT
	MOV	A,L		;HL = 0022H IF CP/M VER 2.2
	CPI	22H+1		;CHECK FOR MPM OR CP/M+
	JNC	MPMYES		;EXIT IF CP/M+, WE CAN'T USE IT
	STA	VERFLG		;STORE THE VERSION
;
;
;=======================================================================
;
;			MAIN PROGRAM ROUTINE
;
;=======================================================================
;
;
SAP:	CALL	SETUP
	CALL	RDDIR
	CALL	CLEAN
	CALL	SORT
	CALL	PACK
	CALL	WRDIR
	CALL	ILPRT
	DB	'DONE',CR,LF,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	FILL$E5
	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
;.....
;
; CP/M 1.4 ROUTINE
;
CPM14:	LHLD	BDOS+1
	MVI	L,0
	MVI	A,(JMP)
	STA	SECTRN
	PUSH	H
	LXI	D,15		;SECTRAN OFFSET FROM BDOS IN CPM 1.4
	DAD	D
	SHLD	SECTRN+1
	POP	H
	LXI	D,3AH		;OFFSET FROM BDOS TO 1.4 DPB
	DAD	D
	MVI	D,0
	MOV	E,M
	INX	H
	XCHG
	SHLD	SPT
	XCHG
	MOV	E,M
	INX	H
	XCHG
	SHLD	DRM
	XCHG
	MOV	A,M
	INX	H
	STA	BSH
	MOV	A,M
	INX	H
	STA	BLM
	MOV	E,M
	INX	H
	XCHG
	SHLD	DSM
	XCHG
	MOV	E,M
	INX	H
	XCHG
	SHLD	AL0
	XCHG
	MOV	E,M
	XCHG
	SHLD	SYSTRK
	RET
;.....
;
;
; CP/M 2.2 ROUTINE
;
CPM22:	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
;.....
;
;
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
	LXI	H,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
	LDA	VERFLG
	ORA	A
	RZ
	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:	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
;.....
;
;
; PRINT A STRING: ADDRESS IS ON TOP OF STACK
;
ILPRT:	XTHL			;GET ADR FROM STACK
	MOV	A,M		;GET CHARACTER
	INX	H		;POINT TO NEXT ADR
	XTHL			;RESTORE TO STACK
	ORA	A		;ARE WE DONE?
	RZ			;YES, RETURN PAST STRING
	PUSH	H		;IN CASE CBIOS CLUBBERS IT
	MOV	C,A		;CHARACTER TO C FOR CP/M
	CALL	CO		;PRINT CHARACTER
	POP	H
	JMP	ILPRT		;CONTINUE
;.....
;
;
INDEX:	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	LXI	D,BUF
	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
;.....
;
;
; MPM OR CP/M+ NOT ALLOWED WITH THIS PROGRAM
;
MPMYES:	CALL	ILPRT
	DB	CR,LF,'** SAP not useable with MPM or CP/M+ **',0
	JMP	EXIT
;.....
;
;
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	ILPRT
	DB	CR,LF,'---> 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	ILPRT		;PRINT:
	DB	'++ READ ERROR - Exiting to CP/M - NO CHANGE made'
	DB	CR,LF,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:	LDA	FCB
	DCR	A
	JP	SETUP1		;EXIT IF DISK DRIVE MENTIONED
	MVI	C,GETDSK	;OTHERWISE GET CURRENT DEFAULT DRIVE
	CALL	BDOS		;SO QUERY 'BDOS' FOR DRIVE
;
SETUP1:	MOV	C,A
	CALL	SELDSK
	LDA	VERFLG		;IF CPM 1.4
	ORA	A
	JZ	CPM14		;IF 1.4, THEN DO IT THE 1.4 WAY
	JMP	CPM22		;MUST BE 2.2 THEN SINCE NOT MPM
;.....
;
;
; SORT THE DIRECTORY
;
SORT:	CALL	ILPRT
	DB	'Sorting, ',0

;
; SHELL-METZNER SORT
;
	LHLD	I
	SHLD	SNUMRECW
	LXI	H,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
	PUSH	PSW
	MOV	A,M
	ANI	7FH
	MOV	B,A
	POP	PSW
	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.
;
NOTEQU:	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	ILPRT
	DB	'Writing,  ',0
	MVI	A,1
	JMP	DODIR
;.....
;
;
; COME HERE IF WE GET A WRITE ERROR
;
WERROR: CALL	ILPRT		;PRINT:
	DB	'++ WRITE ERROR - Exiting to CP/M - directory left '
	DB	'in UNKNOWN condition ++',CR,LF,0
	JMP	EXIT
;.....
;
;
; DATA AREA
;
ADDR:	DS	2
DIRCNT: DS	2
I:	DS	2
J:	DS	2
MAPPTR: DS	2
NOBOOT:	DS	1
NOSWAP:	DS	1
SECTBL: DS	2
SECTOR: DS	2
TRACK:	DS	2
VERFLG: DS	1
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
;.....
;
;
	DS	26		;STACK NEVER GETS THIS DEEP
STACK:	DS	2		;SPACE FOR OLD STACK ADDRESS
;
;
EVEN:	EQU	($+255)/256*256	;START BUFFER ON EVEN PAGE
;
	ORG	EVEN
;
BUF:	DS	0
;.....
;
;
	END
;
TRACTION SUBROUTINE...
; HL=