; PROGRAM TO WRITE A DIRECTORY LISTING TO AN ASCII FILE
; IN A FORM SUITABLE FOR USE WITH A SUBMIT FILE (AFTER
; SUITABLE PROCESSING WITH ED).
;
; THE COMMAND FORMAT IS:
;
;	A>DIRLST  NAME.EXT
;
;	  WHERE  NAME.EXT IS THE FILE NAME TO SAVE THE DIRECTORY IN.
;
;
;
;
;	BY BRUCE KENDALL  1/1980
;	BUG FIXED 2/9/80
;		 10/4/80
;		  1/11/81	; ADDED MORE '???' FOR WILD CARD
;				;  TO FIX CP/M 2.2 BUG
;
;	4/10/81			;changed formatting to eliminate
;				;extraneous characters at start of
;				;each file name (Ray Glueck)
;
; ---CP/M EQUATES ---
;
FCB	EQU	5CH
BDOS	EQU	05
FPRT	EQU	9
FCLOSE	EQU	16
DELETE	EQU	19
WRITE	EQU	21
MAKE	EQU	22
SDMA	EQU	26
SRCH	EQU	17
SRCHX	EQU	18
;
DMA	EQU	80H	; DMA LOCATION
;
	ORG	100H	;CP/M TPA
;
	LXI	H,0
	DAD	SP
	SHLD	OLDSTK	;SAVE OLD STACK POINTER
;
;
START:	LXI	SP,STACK
;
	LXI	D,MSG1	;POINT TO NAME ERROR MESSAGE
	LDA	FCB+1	;GET FIRST CHAR. OF NAME
	CPI	20H
	JZ	ERROR+3
	JC	ERROR+3	;IF BAD NAME
;
	LXI	D,MSG	;POINT TO STARTUP MESSAGE
	CALL	PTMSG	;PRINT OUT MESSAGE
;
	LXI	D,DMA	;GET STD DMA ADDRESS
	MVI	C,SDMA
	CALL	BDOS
;
	LXI	D,FCB	;POINT TO FCB
	MVI	C,DELETE	;FUNCTION TO DELETE A FILE
	CALL	BDOS
;
	XRA	A
	STA	FCB+12	; CLEAR EXTENT BYTE
	STA	FCB+32	; CLEAR NEXT RECORD BYTE
	LXI	D,FCB
	MVI	C,MAKE
	CALL	BDOS	;CREATE FILE
	CPI	0FFH
	JZ	ERROR
;
	LXI	H,BUFF	;POINT TO START OF MEMORY BUFFER
	SHLD	BUFPTR	;SAVE POINTER
;
	MVI	C,SRCH	;SETUP FOR DIRECTORY SEARCH
LST:	LXI	D,FCB1	;POINT TO WILD CARD FCB
	CALL	BDOS
	CPI	0FFH	;TEST FOR END OF DIRECTORY
	JZ	FLZ	;YES, DUMP BUFFER TO DISC FILE
	ANI	03H	;NO, SO MASK BYTE ADDRESS
	RLC
	RLC		;MULTIPLY BY 32 (32 BYTES/FCB)
	RLC
	RLC
	RLC
	ADI	DMA AND 00FFH	;ADD IN START OF DMA BUFFER
	LXI	D,DMA	; GET INTO (D,E)
	MOV	E,A
	INX	D	;POINT TO START OF FILE NAME
	LXI	H,11	;GET OFFSET TO EXTENT BYTE
	DAD	D	;POINT TO EXTENT
	MOV	A,M	;GET IT
	ORA	A	;IS IT ZERO?
	JNZ	LST1	;IF NOT FIRST EXTENT
;	MVI	A,':'	;GET DELIMITER
;	CALL	STORE
;	CALL	STORE
;	CALL	STORE	;PUT DELIMITERS AHEAD OF FILE NAME
;
	MVI	B,8	;LENGTH OF FILE NAME
	CALL	STOREN	;SAVE NAME
;
	MVI	A,'.'	;DELIMITER BETWEEN NAME AND EXTENT
	CALL	STORE
;
	MVI	B,3	;LENGTH OF EXTENT
	CALL	STOREN	;SAVE EXTENT
;
	MVI	A,0DH	;PUT IN CRLF
	CALL	STORE
	MVI	A,0AH
	CALL	STORE
;
LST1:	MVI	C,SRCHX ;SET TO SEARCH FOR NEXT NAME
	JMP	LST
;
STOREN: LDAX	D	;GET CHAR. OF FILE NAME
 	CPI	' '	;IS IT A SPACE?
 	CNZ	STORE	;NO, SO SAVE IT
	INX	D	;INCREMENT POINTER
	DCR	B	;COUNT DOWN CHARACTERS
	JNZ	STOREN	;LOOP UNTIL DONE
	RET
;
FLZ:	MVI	A,'Z'-40H	;GET A CONTROL-Z
CZ1:	CALL	STORE	;PUT IT IN BUFFER
	JNZ	CZ1	;FILL OUT SECTOR BUFFER WITH CTL-Z
;
	LXI	H,BUFF	;POINT TO START OF BUFFER
	SHLD	WPTR	;SAVE POINTER
WMORE:	LHLD	WPTR	;GET POINTER
	XCHG		;INTO (D,E)
	MVI	C,SDMA	;SET TO MOVE DMA BUFFER
	CALL	BDOS	;DO IT
	LXI	D,FCB	;POINT TO FCB
	MVI	C,WRITE	;SET TO WRITE DMA BUFFER TO DISC
	CALL	BDOS	;DO IT
	ORA	A
	JNZ	ERROR	;IF ERROR, EXIT WITH MESSAGE
;
	LHLD	WPTR	;GET BUFFER POINTER
	LXI	D,80H	;SIZE OF DMA BUFFER
	DAD	D	;COMPUTE NEW POINTER
	SHLD	WPTR	;SAVE IT
	LDA	BUFPTR+1	;GET UPPER ADDRESS OF BUFFER
	CMP	H	;COMPARE IT WITH CURRENT WRITE POINTER
	JZ	CLOSE	;CLOSE FILE IF THEY ARE THE SAME
	JNC	WMORE	;LOOP TO SAVE ALL OF BUFFER TO DISC
;
CLOSE:	LXI	D,80H	;GET STD DMA ADDRESS
	MVI	C,SDMA
	CALL	BDOS	;RESET DMA ADDRESS
	LXI	D,FCB
	MVI	C,FCLOSE
	CALL	BDOS	;CLOSE FILE
;
EXIT:	LHLD	OLDSTK	;GET OLD STACK POINTER BACK
	SPHL
	JMP	0	;RETURN TO CP/M
;
STORE:	LHLD	BUFPTR	;GET BUFFER POINTER
	MOV	M,A	;SAVE BYTE IN MEMORY BUFFER
	MOV	C,A	;AND IN (C)
	INX	H	;POINT TO NEXT LOCATION
	MOV	A,L	;GET LOWER ADDRESS BYTE
	ORA	A	;IS IT ZERO?
	MOV	A,C	;RESTORE BYTE
	SHLD	BUFPTR	;SAVE NEW BUFFER POINTER
	RET
;
PTMSG:	MVI	C,FPRT	;GET CP/M MESSAGE PRINT CODE
	JMP	BDOS	;EXECUTE PRINT FUNCTION
;
ERROR:	LXI	D,MSGE	;POINT TO ERROR MESSAGE
	CALL	PTMSG
	JMP	EXIT	;RETURN TO CP/M
;
MSG:	DB	0DH,0AH,' --- DIRECTORY SAVER ver 1.1 ---',0DH,0AH,'$'
MSG1:	DB 0DH,0AH,07,' -- INVALID FILE NAME --',0DH,0AH,0DH,0AH
	DB ' THE PROPER CALLING SEQUENCE IS:',0DH,0AH,0DH,0AH
	DB '        A>DIRLST  NAME.EXT',0DH,0AH,0DH,0AH
	DB '   WHERE  NAME.EXT IS THE FILE NAME TO SAVE THE DIRECTORY IN.'
	DB 0DH,0AH,'$'
MSGE:	DB	0DH,0AH,07,' -- R/W ERROR --',0DH,0AH,'$'
;
FCB1:	DB 0,'???????????????????'	;FCB FOR DIRECTORY SEARCH
;
OLDSTK:	DS	2	;BUFFER FOR OLD STACK POINTER
BUFPTR:	DS	2	;BUFFER POINTER FOR FILLING IT
WPTR:	DS	2	;BUFFER POINTER FOR SAVING IT ON DISC
	DS	80H	;ROOM FOR STACK
STACK:	DS	1
;
	ORG	(($+101H) AND 0FF00H)	;START BUFFER ON PAGE BOUNDARY
BUFF	DB	0
;
	END