;QCAT.ASM
;V0.6
;6/23/78 QUICK CATALOG ROUTINE
;
;2/4/81  DISK RESET ADDED BEFORE DISKS EXCHANGED
;        TO ALLOW USE ON DUAL-DENSITY SYTEMS (C. STROM)
;
;DEFINE MOVE MACRO FOR CONVENIENCE
;
MOVE	MACRO	?F,?T,?L,?I
	IF	NOT NUL ?F
	LXI	D,?F
	ENDIF
	IF	NOT NUL ?T
	LXI	H,?T
	ENDIF
	IF	NOT NUL ?L
	MVI	B,?L
	ENDIF
	IF	NOT NUL ?I
	LOCAL	H,Z
	CALL	Z
H	DB	?I
Z	MVI	B,Z-H
	POP	D
	ENDIF
	CALL	MOVER
	ENDM
;CPM FUNCTION MACRO -
;	CPM FNC,ADDR
CPM	MACRO	?F,?A,?T
	PUSH	B
	PUSH	D
	PUSH	H
	IF	NOT NUL ?A
	LXI	D,?A
	ENDIF
	IF	NOT NUL ?T
	MOV	E,A	;;FOR TYPE
	ENDIF
	MVI	C,?F
	CALL	BDOS
	POP	H
	POP	D
	POP	B
	ENDM
;
	ORG	100H
	LXI	H,0
	DAD	SP
	SHLD	STACK
	LXI	SP,STACK
;
;SAVE THE INPUT DISK NAME, IF THERE IS ONE
;
	LXI	H,BUFF
	LDA	FCB+1
	CPI	' '
	JZ	NONAME
	CPI	'-'
	JZ	GOTDASH
BADNAME	CALL	ERXIT
	DB	'++MUST USE DISK NAME WITH ''-'' AS '
	DB	'THE FIRST CHARACTER,',0DH,0AH
	DB	'AND NNN AS THE FILETYPE$'
GOTDASH	LDA	FCB+9
	MOV	A,M
	CPI	' '
	JZ	BADNAME
	MOVE	FCB+1,BUFF,8
	MOVE	,,,'.'
	MOVE	FCB+9,,3
	MVI	M,0DH
	INX	H
	MVI	M,0AH
	INX	H
	MVI	A,1
	STA	FCB	;COUNT THE '-' NAME
NONAME	PUSH	H
CATMSG	CALL	ILPRT
	DB	'LOAD DISK TO BE CATALOGED, '
	DB	'THEN PRESS D: ',0
	CPM	RDCON
	ANI	5FH	;MAKE UPPER CASE
	CPI	'D'
	JNZ	CATMSG
	CPM	RESETDK ;RESET THE DISK
			;FOR DUAL-DENSITY SYSTEM
;MAKE FCB ALL '?'
	MOVE	,FCB+1,,'???????????'
;READ THE DIRECTORY ENTRIES
;
	POP	H
	MVI	C,SRCHF
	JMP	CALLB
LOOP	MVI	C,SRCHN
CALLB	PUSH	H
	LXI	D,FCB
	CALL	BDOS
	POP	H
	INR	A
	JZ	NOMORE
;
;MOVE THE NAME INTO THE BUFFER
;
	DCR	A	;GET BACK ORIG VALUE
	ANI	3
	PUSH	H
	MOV	L,A
	MVI	H,0
	DAD	H	;X32
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	LXI	D,80H
	DAD	D
;HL NOW POINTS TO ENTRY
	XCHG
	INX	D	;SKIP FIRST BYTE
	POP	H
	MOVE	,,8
	MVI	M,'.'
	INX	H
	MOVE	,,3
	MVI	M,0DH
	INX	H
	MVI	M,0AH
	INX	H
;INCREMENT FILE COUNT
	LDA	FCT
	INR	A
	STA	FCT
	JMP	LOOP	;GET NEXT
;
;NO MORE ENTRIES
;
NOMORE	MVI	M,'Z'-40H
	SHLD	ENDADDR	;SAVE FOR WRITE
NEXTS	LDA	FCT	;GET FILE COUNT
	DCR	A
	STA	FCT
	JZ	DONE	;ALL DONE
;
;PASS THRU THE BUFF, SORTING IT.
;
	MOV	C,A	;SAVE COUNT
	LXI	D,BUFF
COMPR	LXI	H,14
	DAD	D
	PUSH	D
	PUSH	H
	MVI	B,14	;COMPARE LENGTH
CLCLP	LDAX	D
	CMP	M
	JC	NEXTC
	JNZ	DIFF
SAME	INX	D
	INX	H
	DCR	B
	JNZ	CLCLP
NEXTC	POP	H
	POP	D
	XCHG
NEXTC2	DCR	C	;MORE?
	JNZ	COMPR	;CHECK NEXT 2
;
;COMPLETED PASS THRU BUFF
;
	JMP	NEXTS
;
;UNEQUAL COMPARE
;
DIFF	POP	H
	POP	D	;GET POINTERS
;SWAP
	MVI	B,14
	PUSH	B
SWAP	MOV	C,M
	LDAX	D
	MOV	M,A
	MOV	A,C
	STAX	D
	INX	D
	INX	H
	DCR	B
	JNZ	SWAP
	POP	B
	JMP	NEXTC2
;
;SORT ALL DONE - WRITE 'NAMES.SUB'
;
DONE	LDA	BUFF
	CPI	'-'
	JZ	NAMEOK
	CALL	ILPRT
	DB	'++MISSING ''-'' NAME ON DISK OR '
	DB	'QCAT COMMAND',0DH,0AH
	DB	'RELOAD CATALOG DISK, PRESS RETURN',0
	CPM	RDCON
	CALL	ERXIT
	DB	'++RUN QCAT, THIS TIME WITH NAME OPERAND$'
NAMEOK	CALL	ILPRT
	DB	'MOUNT CATALOG DISK, PRESS RETURN',0
	CPM	RDCON
	CPM	RESETDK	;RESET DISK, KILLING R/O STATUS
	CPM	SELDK,0
	MOVE	,FCB+1,,'NAMES   SUB'
	CPM	ERASE,FCB
	CPM	MAKE,FCB
	INR	A
	JZ	BADMAKE
	LXI	D,BUFF
WRLP	PUSH	D
	CPM	STDMA
	CPM	WRITE,FCB
	ORA	A
	JNZ	WRERR
	POP	D
	LXI	H,80H
	DAD	D
	XCHG
	MOV	A,D
	LDA	ENDADDR+1
	INR	A
	CMP	D
	JNC	WRLP
	CPM	STDMA,80H
	CPM	CLOSE,FCB
	CALL	ERXIT
	DB	'++DONE.  NOW ISSUE COMMAND:',0DH,0AH
	DB	'UCAT$'
WRERR	CALL	ERXIT
	DB	'++WRITE ERROR$'
BADMAKE	CALL	ERXIT
	DB	'++CAN''T MAKE NAMES.SUB$'
;
;INLINE PRINT
;
ILPRT	MVI	A,0DH
	CALL	TYPE
	MVI	A,0AH
	CALL	TYPE
	XTHL
ILPLP	MOV	A,M
	CALL	TYPE
	INX	H
	MOV	A,M
	ORA	A
	JNZ	ILPLP
	INX	H
	XTHL
	RET
;
;TYPE CHAR IN A
;
TYPE	CPM	WRCON,,TYPE
	RET
;
;CHAR MOVE ROUTINE, (DE) -> (HL) LEN IN B
;
MOVER	LDAX	D
	MOV	M,A
	INX	D
	INX	H
	DCR	B
	JNZ	MOVER
	RET
FCT	DB	0	;FILE COUNT
ENDADDR	DS	2	;END OF FILE
;FOLLOWING FROM 'EQU5.LIB'---->
	DS	40H	;STACK AREA
STACK	DS	2
;
;EXIT WITH ERROR MESSAGE
ERXIT	MVI	A,0DH
	CALL	TYPE
	MVI	A,0AH
	CALL	TYPE
	POP	D	;GET MSG
	MVI	C,PRINT
	CALL	BDOS
;EXIT, RESTORING STACK AND RETURN
EXIT	LHLD	STACK
	SPHL
	RET		;TO CCP
BUFF	EQU	$
;BDOS/CBIOS EQUATES (VERSION 6)	
RDCON	EQU	1
WRCON	EQU	2
PRINT	EQU	9
RESETDK	EQU	13
SELDK	EQU	14
OPEN	EQU	15
CLOSE	EQU	16
SRCHF	EQU	17
SRCHN	EQU	18
ERASE	EQU	19
READ	EQU	20
WRITE	EQU	21
MAKE	EQU	22
STDMA	EQU	26
BDOS	EQU	5
FCB	EQU	5CH 

