	TITLE	'SORTED DIRECTORY MAP PROGRAM'
	ORG	100H
	JMP	START	;SKIP PROGRAM ID
	DB	'(FMAP 3/19/80)' 
;SORTED DIRECTORY MAP PROGRAM
;WITH OPTION OF WRITING FILE OF NAMES
; MODIFIED BY W. EARNEST FOR MULTIPLE EXTENTS
; MODIFIED 3/80 FOR CP/M REV 2.01
; MODIFIED BY A. I. LARKY TO WRITE A SIZE FILE
;	800719
;
;FMAP D:FN.FT OR JUST FMAP
;FMAP D:FN.FT F   TO WRITE A FILE
;ALLOWS '*' OR '?' TYPE SPECIFICATIONS
FCB	EQU	5CH	;SYSTEM FCB
;SAVE THE STACK
START	LXI	H,0
	DAD	SP	;H=STACK
	SHLD	STACK	;SAVE IT
	LXI	SP,STACK ;GET NEW STACK
;SAVE FILE WRITE REQUEST CHAR
	LDA	FCB+17
	STA	FILESW
;NO FCB SPECIFIED?
	LXI	H,FCB+1
	MOV	A,M
	CPI	' '
	JNZ	GOTFCB
;NO FCB - MAKE FCB ALL '?'
	MVI	B,12	;FN+FT COUNT+EXTENT
QLOOP	MVI	M,'?'	;STORE '?' IN FCB
	INX	H
	DCR	B
	JNZ	QLOOP
;LOOK UP THE FCB IN THE DIRECTORY
GOTFCB	MVI	C,FSRCHF ;GET 'SEARCH FIRST' FNC
	LXI	D,FCB
	CALL	BDOS	;READ FIRST
	INR	A	;WERE THERE ANY?
	STA	TEMP	;SAVE
	JNZ	PRTTL	;GOT SOME - PRT TITLE, CONT
	LXI	D,NONMSG
	CALL	WRCON
	JMP	EXIT
NONMSG	DB	'++NOT FOUND$'
;PRINT TITLE
PRTTL	LXI	D,TTL
	CALL	WRCON
	CALL	CR
	LDA	TEMP	;RELOAD EXTENT
	JMP	SOME
TTL	DB	'FILENAME TYP EX RC -----EXTENT-----$'
;READ MORE DIRECTORY ENTRIES
MOREDIR	MVI	C,FSRCHN ;SEARCH NEXT
	LXI	D,FCB
	CALL	BDOS	;READ DIR ENTRY
	INR	A	;CHECK FOR END (0FFH)
	JZ	SPRINT	;NO MORE - SORT & PRINT
;POINT TO DIRECTORY ENTRY 
SOME	DCR	A	;UNDO PREV 'INR A'
	ANI	3	;MAKE MODULUS 4
	ADD	A	;MULTIPLY...
	ADD	A	;..BY 32 BECAUSE
	ADD	A	;..EACH DIRECTORY
	ADD	A	;..ENTRY IS 32
	ADD	A	;..BYTES LONG
	LXI	H,81H	;POINT TO BUFFER
			;(SKIP TO FN/FT)
	ADD	L	;POINT TO ENTRY
	MOV	L,A	;SAVE (CAN'T CARRY TO H)
;MOVE ENTRY TO TABLE
	XCHG		;ENTRY TO DE
	LHLD	NEXTT	;NEXT TABLE ENTRY TO HL
	MVI	B,11	;ENTRY LENGTH OF NAME
TMOVE1	LDAX	D	;GET ENTRY CHAR
	ANI	7FH	;STRIP ANY FLAG BIT
	MOV	M,A	;STORE IN TABLE
	INX	D
	INX	H
	DCR	B	;MORE?
	JNZ	TMOVE1
	MVI	B,20
TMOVE2:	LDAX	D
	MOV	M,A	;SAVE FULL BYTE
	INX	D
	INX	H
	DCR	B
	JNZ	TMOVE2
	SHLD	NEXTT	;SAVE UPDATED TABLE ADDR
	LDA	COUNT	;GET PREV COUNT
	INR	A
	STA	COUNT
	JMP	MOREDIR
;SORT AND PRINT
SPRINT	LDA	COUNT	;INIT THE ORDER TABLE
	LXI	H,ORDER
	LXI	D,TABLE
	LXI	B,31	;ENTRY LENGTH
BLDORD	MOV	M,E	;SAVE LO ORD ADDR
	INX	H
	MOV	M,D	;SAVE HI ORD ADDR
	INX	H
	XCHG		;TABLE ADDR TO HL
	DAD	B	;POINT TO NEXT ENTRY
	XCHG
	DCR	A	;MORE?
	JNZ	BLDORD	;..YES
	LDA	COUNT	;GET COUNT
	STA	SCOUNT	;SAVE AS # TO SORT
	DCR	A	;ONLY 1 ENTRY?
	JZ	DONE	;..YES, SO SKIP SORT
SORT	XRA	A	;GET A ZERO
	STA	SWITCH	;SHOW NONE SWITCHED
	LDA	SCOUNT	;GET COUNT
	DCR	A	;USE 1 LESS
	STA	TEMP	;SAVE # TO COMPARE
	STA	SCOUNT	;SAVE HIGHEST ENTRY
	JZ	DONE	;EXIT IF NO MORE
	LXI	H,ORDER ;POINT TO ORDER TABLE
SORTLP	CALL	COMPR	;COMPARE 2 ENTRIES
	CM	SWAP	;SWAP IF NOT IN ORDER
	INX	H	;BUMP ORDER
	INX	H	;..TABLE POINTER
	LDA	TEMP	;GET COUNT
	DCR	A
	STA	TEMP
	JNZ	SORTLP	;CONTINUE
;ONE PASS OF SORT DONE
	LDA	SWITCH	;ANY SWAPS DONE?
	ORA	A
	JNZ	SORT
;SORT IS ALL DONE - PRINT ENTRIES
DONE	LXI	H,ORDER
	SHLD	NEXTT
;IF WRITING A FILE, OPEN THE FILE
	LDA	FILESW
	CPI	'F'
	JNZ	ENTRY
	LXI	D,MYFCB
	MVI	C,ERASE
	CALL	BDOS
	LXI	D,MYFCB
	MVI	C,FMAKE	;MAKE THE FILE
	CALL	BDOS
	INR	A
	JNZ	ENTRY
;MAKE ERROR
	CALL	ERXIT
	DB	'++FILE MAKE ERROR$'
;PRINT AN ENTRY
ENTRY	MVI	C,CONST	;CK STATUS OF KB
	CALL	BDOS	;ANY KEY PRESSED?
	DCR	A
	JZ	ABORT	;YES, ABORT
	LHLD	NEXTT	;GET ORDER TABLE POINTER
	MOV	E,M	;GET LO ADDR
	INX	H
	MOV	D,M	;GET HI ADDR
	INX	H
	SHLD	NEXTT	;SAVE UPDATED TABLE POINTER
	LXI	H,11	;OFFSET TO EXTENT
	DAD	D
	MOV	A,M	;GET EXTENT
	ANA	A
	JZ	ENTRY2	;EXTENT 0
	LXI	H,FILESW
	INR	M	;SET NO-COPY FLAG
ENTRY2:	XCHG		;TABLE ENTRY TO HL
	MVI	B,8	;FILE NAME LENGTH
	CALL	TYPEIT	;TYPE FILENAME
	CALL	PERIOD	;SPACE AFTER FN
	MVI	B,3	;GET THE FILETYPE
	CALL	TYPEIT
	CALL	FILECR
	MOV	A,M	;GET EXTENT
	CALL	XOB	;PRINT IT
	INX	H	;SKIP EXTENT
	INX	H	;SKIP
	INX	H	;UNUSED
	MOV	A,M	;GET REC COUNT
	DCR	A	;FUDGE
	JM	EXTLP0	;NO SIZE, SO SKIP ACCOUNTING
	RAR		;DIVIDE
	RAR		;..BY 8
	RAR
	ANI	1FH	;DELETE GARBAGE
	INR	A	;MAKE RELATIVE TO 1, NOT 0
	MOV	B,A	;SAVE AS # CLUSTERS
;  COMPUTE REMAINING SPACE
	LDA	KLEFT
	SUB	B
	STA	KLEFT
EXTLP0:	MOV	A,M	;RELOAD RECORD COUNT
	CALL	XOB	;PRINT RECORD COUNT
	INX	H	;SKIP RECORD COUNT
	MVI	C,0	;FOR CLUSTER SKIP CTL
EXTLP	MOV	A,M	;GET CLUSTER BYTE
	ORA	A	;EMPTY?
	JZ	ENDEXT	;..YES
	CALL	XO	;..NO, PRINT IT
	INR	C	;INCR COUNT
	MOV	A,C	;TIME TO SPACE?
	ANI	3
	CZ	SPACE
	INX	H	;POINT TO NEXT CHR
	DCR	B	;MORE IN EXTENT?
	JNZ	EXTLP	;YES
;BUMP TOTAL FILE COUNT
ENDEXT:	LDA	NFILE	;GET # FILES
	INR	A	;BUMP
	DAA		;MAKE DECIMAL
	STA	NFILE	;SAVE IT BACK
	CALL	CR	;END, TYPE C/R
;CLEAR UP THE FILE SWITCH
	LDA	FILESW
	ANI	0FEH	;DROP POSSIBLE NO-COPY FLAG
	STA	FILESW
;SEE IF MORE ENTRIES
	LDA	COUNT
	DCR	A
	STA	COUNT
	JNZ	ENTRY	;YES, MORE
; ADD DUMMY FILE WITH LENGTH
	MVI	B,8
	LXI	H,ROOM
	CALL	TYPEIT
	CALL	PERIOD
	LXI	H,TENS
	LDA	KLEFT
	MVI	B,E
DIGIT1:	MVI	C,'0'
DIGIT2:	SUB	M
	JC	DIGIT3	;OVERBORROWED
	INR	C	;COUNT YOUR SUCCESSES
	JMP	DIGIT2	;DON'T QUIT WHILE YOU'RE WINNING
;
DIGIT3:	ADD	M	;RESTORE
	MOV	M,C	;SAVE A DIGIT
	INX	H
	DCR	B
	JNZ	DIGIT1
	LXI	H,TENS	;ANSWER SPOT
	MVI	B,3
	CALL	TYPEIT
	CALL	FILECR
	CALL	CR
;
; ALL DONE - PRINT # FILES
	LDA	NFILE
	CALL	XOB
	LXI	D,NMSG
	CALL	WRCON
;CLOSE FILE IF NECESSARY
	LDA	FILESW
	CPI	'F'
	JNZ	EXIT
	MVI	A,'Z'-40H ;EOF CHAR
	CALL	FILCHR	;WRITE IT
	CALL	WRSEC	;WRITE FINAL SECTOR
	LXI	D,MYFCB
	MVI	C,FCLOSE
	CALL	BDOS
	JMP	EXIT
NMSG	DB	'FILES$'
;HEX OUTPUT W/BLANK
XOB	CALL	XO
	JMP	SPACE
;HEX OUTPUT 
XO	PUSH	PSW	;SAVE CHAR
	RAR
	RAR
	RAR
	RAR
	CALL	NIBBL	;PRINT LEFT NIBBLE
	POP	PSW	;GET VALUE BACK
;
NIBBL	ANI	0FH	;ISOLATE NIBBLE
	CPI	10	;NUMBER?
	JC	XNUM	;YES
	ADI	7	;FUDGE ALPHA HEX
XNUM	ADI	'0'	;MAKE PRINTABLE
;
;TYPE CHAR IN A
TYPE	PUSH	B
	PUSH	D
	PUSH	H
	MOV	E,A
	MVI	C,WRCHR
	CALL	BDOS
	POP	H
	POP 	D
	POP	B
	RET
WRCON	MVI	C,PRINT
	JMP	BDOS
TYPEIT	MOV	A,M
	CALL	FILCHR	;TO DISK IF REQ'D
	CALL	TYPE
	INX	H
	DCR	B
	JNZ	TYPEIT
	RET
SPACE	MVI	A,' '
	JMP	TYPE
CR	MVI	E,13	;PRINT
	MVI	C,2	;C/R
	CALL	BDOS
	MVI	E,10	;LF
	MVI	C,2
	JMP	BDOS
TEMP	DS	1	;SAVE DIR ENTRY
;ERROR EXIT
ERXIT	POP	D	;GET MSG
	MVI	C,PRINT
	JMP	CALLB	;PRINT MSG, EXIT
;ABORT - READ CHAR ENTERED
ABORT	MVI	C,RDCHR
CALLB	CALL	BDOS	;DELETE THE CHAR
;FALL INTO EXIT
;EXIT - ALL DONE , RESTORE STACK
EXIT	LHLD	STACK	;GET OLD STACK
	SPHL		;MOVE TO STACK
	RET		;..AND RETURN
;ROUTINES FOR CREATING FILE
;
;WRITE CHAR IN A TO FILE
;(SAVES ALL REGS INCLUDING A)
FILCHR	CPI	' '
	RZ		;DON'T WRITE BLANKS
	PUSH	PSW
	LDA	FILESW	;WRITING A FILE?
	CPI	'F'
	JNZ	NOFILE
	POP	PSW	;GET CHAR
	PUSH	PSW	;SAVE IT BACK
	PUSH	H
	LHLD	BUFAD	;CURRENT BUFFER ADDR
	MOV	M,A
	INX	H
	SHLD	BUFAD
	MOV	A,H	;SEE IF FULL BUFF
	DCR	A
	CZ	WRSEC	;YES, WRITE SECTOR
	POP	H
NOFILE:	POP	PSW	;RESTORE CHAR
	RET
;WRITE A SECTOR
WRSEC	PUSH	B
	PUSH	D
	LXI	D,MYFCB
	MVI	C,FWRTE
	CALL	BDOS
	ORA	A
	JZ	WROK
	CALL	ERXIT
	DB	'++WRITE ERROR$'
WROK	LXI	H,80H	;START OF BUFF
	SHLD	BUFAD
	POP	D
	POP	B
	RET
;TYPE A PERIOD INTO THE FILE
PERIOD	MVI	A,'.'	;GET PERIOD
	CALL	FILCHR	;WRITE TO FILE
	JMP	SPACE
;WRITE CR/LF INTO FILE
FILECR	MVI	A,13
	CALL	FILCHR
	MVI	A,10
	CALL	FILCHR
	JMP	SPACE
;COMPARE ROUTINE FOR SORT
COMPR	PUSH	H	;SAVE TABLE ADDR
	MOV	E,M	;LOAD LO
	INX	H
	MOV	D,M	;LOAD HI
	INX	H
	MOV	C,M
	INX	H
	MOV	B,M
;BC, DE NOW POINT TO ENTRIES TO BE COMPARED
	XCHG
CMPLP	LDAX	B
	CMP	M
	INX	H
	INX	B
	JZ	CMPLP
	POP	H
	RET		;COND CODE TELLS ALL
;SWAP ENTRIES IN THE ORDER TABLE
SWAP	MVI	A,1
	STA	SWITCH	;SHOW A SWAP WAS MADE
	MOV	C,M
	INX	H
	PUSH	H	;SAVE TABLE ADDR+1
	MOV	B,M
	INX	H
	MOV	E,M
	MOV	M,C
	INX	H
	MOV	D,M
	MOV	M,B
	POP	H
	MOV	M,D
	DCX	H	;BACK POINTER TO CORRECT LOC'N
	MOV	M,E
	RET
	DS	30	;STACK AREA
STACK	DS	2	;SAVE OLD STACK HERE
NFILE	DB	0	;NUMBER OF FILES PRINTED
;
; BDOS EQUATES
;
RDCHR	EQU	1	;READ CHAR FROM CONSOLE
WRCHR	EQU	2	;WRITE CHR TO CONSOLE
PRINT	EQU	9	;PRINT CONSOLE BUFF
CONST	EQU	11	;CHECK CONS STAT
FOPEN	EQU	15	;0FFH=NOT FOUND
FCLOSE	EQU	16	;   "	"
FSRCHF	EQU	17	;   "	"
FSRCHN	EQU	18	;   "	"
ERASE	EQU	19	;NO RET CODE
FREAD	EQU	20	;0=OK, 1=EOF
FWRTE	EQU	21	;0=OK, 1=ERR, 2=?, 255=NO DIR SPC
FMAKE	EQU	22	;255=BAD
FREN	EQU	23	;255=BAD
FDMA	EQU	26
BDOS	EQU	5
REBOOT	EQU	0
NEXTT	DW	TABLE	;NEXT TABLE ENTRY
COUNT	DB	0	;ENTRY COUNT
KLEFT:	DB	241	;STARTING ROOM NUMBER
ROOM	DB	'[[ROOM]]'
SCOUNT	DB	0	;# TO SORT
SWITCH	DB	0	;SWAP SWITCH FOR SORT
TENS:	DB	100,10,1	;TABLE OF DECIMALS
FILESW	DS	1	;'F' IF WRITING FILE
BUFAD	DW	80H	;OUTPUT ADDR
MYFCB	DB	0,'NAMES   SUB',0
	DS	19
	DB	0
;
DIRNO	EQU	64	;NUMBER OF DIRECTORY ENTRIES
;
ORDER	DS	2*DIRNO	;ORDER TABLE
TABLE	EQU	$	;READ ENTRIES IN HERE
	END	100H
