;	LUXDIR12.MAC	LUX Utility DIR transient		01-23-84
;
;  Copyright 1983 by Steven R. Holtzclaw and entered into the public domain.
;
;	Modification history in reverse order:
;
; 01-23-84	Small formatting changes - Added documentation header.
; LUXDIR12	Mark Howard
;
; 11-26-83	Original version ??
; LUXDIR11
;
;
  	.Z80
	ASEG
	ORG	100H
;
CR	EQU	0DH
LF	EQU	0AH
;
DBUF	EQU	80H		; default buffer
FCB	EQU	05CH		; default fcb
FCB2	EQU	06CH
MAXCOL	EQU	4		; number of dir columns
FENCE	EQU	'|'		; fence character
;
BEGIN:	LD	HL,0
	ADD	HL,SP
	LD	(STAKER+1),HL	
	LD	A,(FCB2+1)	; any files specified ?
	CP	020H		; space?
	JR	NZ,BEGN2	; ...no - continue
	LD	HL,FCB2+1	; index fcb2 filename
	LD	A,'?'		; wildcard
	LD	B,11		; 11 bytes to fill
BEGN1:	LD	(HL),A		; put a byte
	INC	HL		; next byte
	DJNZ	BEGN1		; do all 11 bytes
;
BEGN2:	LD	HL,FCB
	LD	DE,FCB1
	LD	BC,12
	LDIR			; move to local fcb
	LD	DE,DBUF		; set default dma address
	LD	C,26
	CALL	5
	LD	DE,FCB1		; index .fcb for search
	LD	C,17
	CALL	5		; search for first
	INC	A
	JP	Z,NOFILE	; barf if not found
	LD	DE,FCB1		; index fcb for open
	LD	C,15
	CALL	5		; open the file for input
	XOR	A
	LD	(DIRS),A	; set dir sector count = 0
	LD	(COL),A		; set column count to 0
	LD	HL,(6)		; get bdos location
	LD	DE,ORDER	; get end of our program
	SBC	HL,DE		; available free memory
;
; calculate the approximate max number of directory entries
;
	LD	B,4		; loop here 4 times
DIVLOP:	SRL	H
	RR	L		; * 2
	DJNZ	DIVLOP		; hl=hl/16
	LD	(MAXDIR),HL	; set the max number of dirs
	ADD	HL,HL
	LD	DE,ORDER
	ADD	HL,DE		; calculate the start of name table
	LD	(NAMBUF),HL	; base location for name table
	LD	(TBLOC),HL	; dito
	CALL	ILPRT
	DEFB	13,10
	DEFB	'LBR directory for ',0
	CALL	PFLNAM		; print the file name
	CALL	ILPRT
	DEFB	13,10,10,0
GETLP:	CALL	RDBLOK		; get a block
	LD	A,(DIRS)	; increment
	INC	A		; directory
	LD	(DIRS),A	; and sector count
	LD	HL,DBUF		; point to first entry
	LD	A,(HL)		; get status byte
	OR	A
	JP	Z,STATOK	; skip if active
;
; the first entry of this sector is inactive.
; if its not sector 1, all's well.  if it is,
; we dont have a lbr file!
;
	LD	A,(DIRS)
	DEC	A
	JP	NZ,ENT2		; skip if not first sector
	CALL	ILPRT
	DEFB	CR,LF
	DEFB	'Directory error in ',0
	CALL	PFLNAM		; print the filename
	CALL	ILPRT
	DEFB	13,10,0
	JP	EXIT
;
STATOK:	LD	A,(DIRS)	; check if first entry
	DEC	A
	JP	NZ,NOTD		; skip if not 1st sector
	LD	HL,DBUF+14	; get lbr directory size...
	LD	A,(HL)		; ...into a
	LD	(DIRSIZ),A	; save dir size...
	JP	ENT2		; ...and skip
;
NOTD:	LD	HL,DBUF+00H
	CALL	ADDBUF
ENT2:	LD	HL,DBUF+20H	; point to second entry
	CALL	ADDBUF		; process it
ENT3:	LD	HL,DBUF+40H	; third entry
	CALL	ADDBUF
ENT4:	LD	HL,DBUF+60H	; last entry for this sector
	CALL	ADDBUF
	LD	A,(DIRS)	; get # of sectors done
	LD	HL,DIRSIZ	; compare with...
	CP	(HL)		; ...total directory size
	JP	NZ,GETLP	; loop if not finished...
	JP	SPRINT		; ...else sort and print the directory
;
; add a member name to nambuf names queue
;
ADDBUF:	LD	A,(HL)		; get status
	OR	A
	RET	NZ		; skip if empty/inactive
	INC	HL
	LD	A,(HL)		; get first byte of member name
	OR	A
	RET	Z		; skip if a null entry
	PUSH	HL		; save dbuff pointer
	LD	DE,FCB2+1	; index 
	LD	B,11		; 11 characters to compare
ADDBU1:	LD	A,(DE)		; get character from fcb2
	CP	'?'		; '?' matches all
	JR	Z,ADDBU2
	CP	(HL)		; same a command line
	JR	NZ,ADDBU3	; ...no - skip this entry
ADDBU2:	INC	HL
	INC	DE
	DJNZ	ADDBU1		; loop for 11 character compares
	POP	HL
	LD	BC,(COUNT)	; dump entry counter
	INC	BC
	LD	(COUNT),BC
	LD	DE,(NAMBUF)	; get destination of move
	LD	BC,11		; 11 character file name
	LDIR			; move it
	INC	HL		; point to file size
	INC	HL
	LD	BC,2		; 2 byte file size
	LDIR			; move it
	LD	(NAMBUF),DE	; save destination of next move
	RET
ADDBU3:	POP	HL		; balance stack
	RET
; 
; sort and print
; 
SPRINT:	LD	HL,(COUNT)	; get file name count
	LD	(MAXNUM),HL	; set number of times to print
	LD	(MEMBRS),HL	; set total number of members
	LD	A,L
	OR	H		; any found?
	JP	Z,DONE		; exit if no files found
	PUSH	HL		; save file count
	LD	(SUPSPC),A	; enable leading zero suppression
; 
; 
; initialize the order table
; 
	LD	HL,(TBLOC)	; get start of name table
	EX	DE,HL		; into de
	LD	HL,ORDER	; point to order table
	LD	BC,13		; entry length
; 
BLDORD:	LD	(HL),E		; save low order address
	INC	HL
	LD	(HL),D		; save high order address
	INC	HL
	EX	DE,HL		; table addr to hl
	ADD	HL,BC		; point to next entry
	EX	DE,HL
	EX	(SP),HL		; save tbl addr, fetch loop counter
	DEC	HL		; count down loop
	LD	A,L
	OR	H		; more?
	EX	(SP),HL		; (restore tbl addr, save counter)
	JP	NZ,BLDORD	; yes, go do another one
	POP	HL		; clean loop counter off stack
	LD	HL,(COUNT)	; get count
	LD	(SCOUNT),HL	; save as # to sort
	DEC	HL		; only 1 entry?
	LD	A,L
	OR	H
	JP	Z,DONE		; yes, so skip sort
; 
; 
; this sort routine is adapted from software tools by kernigan and
; plaugher.
; 
SORT:	LD	HL,(SCOUNT)	; number of entries
; 
SORT0:	OR	A		; clear carry
	LD	A,H		; gap=gap/2
	RRA	
	LD	H,A
	LD	A,L
	RRA	
	LD	L,A
	OR	H		; is it zero?
	JP	Z,DONE		; then none left
	LD	A,L		; make gap odd
	OR	1
	LD	L,A
	LD	(GAP),HL
	INC	HL		; i=gap+1
; 
SORT2:	LD	(VARI),HL
	EX	DE,HL
	LD	HL,(GAP)
	LD	A,E		; varj=i-gap
	SUB	L
	LD	L,A
	LD	A,D
	SBC	A,H
	LD	H,A
; 
SORT3:	LD	(VARJ),HL
	EX	DE,HL
	LD	HL,(GAP)	; jg=varj+gap
	ADD	HL,DE
	LD	(VARJG),HL
	LD	A,12		; compare 12 chars
	CALL	COMPARE		; compare (varj) and (jg)
	JP	P,SORT5		; if a(varj)<=a(jg)
	LD	HL,(VARJ)
	EX	DE,HL
	LD	HL,(VARJG)
	CALL	SWAP		; exchange a(varj) and a(jg)
	LD	HL,(VARJ)	; varj=varj-gap
	EX	DE,HL
	LD	HL,(GAP)
	LD	A,E
	SUB	L
	LD	L,A
	LD	A,D
	SBC	A,H
	LD	H,A
	JP	M,SORT5		; if varj>0	goto l3
	OR	L		; check for zero
	JP	Z,SORT5
	JP	SORT3
; 
SORT5:	LD	HL,(SCOUNT)	; for later
	EX	DE,HL
	LD	HL,(VARI)	; i=i+1
	INC	HL
	LD	A,E		; if i<=n goto l2
	SUB	L
	LD	A,D
	SBC	A,H
	JP	P,SORT2
	LD	HL,(GAP)
	JP	SORT0
; 
; new compare routine
; 
COMPARE:
	LD	BC,ORDER-2
	ADD	HL,HL
	ADD	HL,BC
	EX	DE,HL
	ADD	HL,HL
	ADD	HL,BC
	EX	DE,HL
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	EX	DE,HL
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	EX	DE,HL
	LD	E,A		; count
; 
CMPLPE:	LD	A,(HL)
	AND	7FH
	LD	D,A
	LD	A,(BC)
	AND	7FH
	CP	D
	INC	BC
	INC	HL
	RET	NZ
	DEC	E
	JP	NZ,CMPLPE
	RET	
; 
; 
; swap entries in the order table
; 
SWAP:	LD	BC,ORDER-2	; table base
	ADD	HL,HL		; *2
	ADD	HL,BC		; + base
	EX	DE,HL
	ADD	HL,HL		; *2
	ADD	HL,BC		; + base
	LD	C,(HL)
	LD	A,(DE)
	EX	DE,HL
	LD	(HL),C
	LD	(DE),A
	INC	HL
	INC	DE
	LD	C,(HL)
	LD	A,(DE)
	EX	DE,HL
	LD	(HL),C
	LD	(DE),A
	RET	
; 
; sort is all done - print entries
; 
DONE:
PLOOP:	LD	HL,(MAXNUM)	; get number of entries to print
	LD	A,H
	OR	L
	JP	Z,PLOOP6	; if all done
;
PLOOP1:	LD	HL,ORDER	; index order
	LD	E,(HL)		; get entry lsb
	INC	HL		; next
	LD	D,(HL)		; get entry msb
	INC	HL		; next
	LD	(PLOOP1+1),HL	; set next order address
	EX	DE,HL		; hl scans the entry
;
	LD	B,8		; 8 character file name
PLOOP2:	LD	A,(HL)		; get a byte
	CALL	CTYPE		; print it
	INC	HL		; next character
	DJNZ	PLOOP2		; do 8 characters
	LD	A,'.'
	CALL	CTYPE		; print the seperator
	LD	B,3		; 3 character file name
PLOOP3:	LD	A,(HL)		; get a byte
	CALL	CTYPE		; print it
	INC	HL		; next character
	DJNZ	PLOOP3		; do 3 characters
	LD	E,(HL)		; get the number of sectors into de
	INC	HL
	LD	D,(HL)
	EX	DE,HL		; put number into hl
	CALL	ADDTOT		; add to total sectors
	LD	B,3
PLOOP4:	SRL	H
	RR	L
	DJNZ	PLOOP4
	INC	HL		; round up to nearest k
	CALL	PNUMB1		; print hl as 5-digit decimal
	CALL	ILPRT		; print the "s" in "sectors"
	DEFB	'k',0
	LD	C,6		; bdos direct function call
	LD	E,0FFH
	CALL	5		; get keyboard character
	CP	3		; control c?
	JP	Z,EXIT		; ...yes - abort
	LD	HL,(MAXNUM)
	DEC	HL
	LD	(MAXNUM),HL	; bump counter down
	LD	A,(COL)		; increment...
	INC	A		; ...column count
	LD	(COL),A
	CP	MAXCOL		; reached max column?
	JR	NZ,PLOOP5	; not yet - back to caller
	XOR	A		; reached max column...
	LD	(COL),A		; ...set it to zero...
	CALL	CRLF		; ...and start a new line
	JP	PLOOP
PLOOP5:	LD	A,L
	OR	H
	JP	Z,PLOOP
	CALL	ILPRT
	DEFB	' ',FENCE,' ',0
	JP	PLOOP
;
PLOOP6:	LD	HL,(SECTRS)	; get sector count
	LD	A,L
	OR	H		; test for no files
	JR	NZ,PLOO6A	; ...if there are any sectors in .lbr
	CALL	ILPRT
	DEFB	'No file(s)',0
	JP	EXIT
;
PLOO6A:	CALL	ILPRT
	DEFB	13,10,13,10,'This file contains ',0
	LD	HL,(MEMBRS)
	CALL	PNUMB0
	CALL	ILPRT
	DEFB	' members in ',0
	LD	HL,(SECTRS)
	CALL	PNUMB0
	CALL	ILPRT
	DEFB	' active sectors for a total of ',0
	LD	HL,(SECTRS)
	LD	B,3
PLOOP7:	SRL	H
	RR	L
	DJNZ	PLOOP7
	INC	HL
	CALL	PNUMB0
	CALL	ILPRT
	DEFB	'k',13,10,0
	JP	EXIT
;
RDBLOK:	LD	DE,DBUF
	LD	C,26
	CALL	5
	LD	DE,FCB1		; point to our fcb
	LD	C,20
	CALL	5
	OR	A
	RET	Z
	CALL	ILPRT
	DEFB	13,10,'Premature eof in file',13,10,0
	JP	EXIT		; abort
;
ADDTOT:	PUSH	HL		; save sector count
	EX	DE,HL		; keep sector count in 'DE' for the add
	LD	HL,(SECTRS)
	ADD	HL,DE
	LD	(SECTRS),HL	; put number back
	JR	NC,ADDTO1	; if no overflow
	LD	A,(SECTRS+2)	; get sectors msb
	INC	A		; + 1
	LD	(SECTRS+2),A	; put ot back
ADDTO1:	POP	HL		; restore sector count
	RET			; return to caller
	
;
NOFILE:	CALL	ILPRT
	DEFB	CR,LF
	DEFB	'No such file on disk',CR,LF,0
	JP	EXIT
;
EXIT:
STAKER:	LD	SP,STACK
	RET
;
PFLNAM:	LD	HL,FCB1+1
	LD	B,8		; 8 character file name
PFLNA1:	LD	A,(HL)		; get character
	CP	020H		; space ?
	CALL	NZ,CTYPE	; no - print the character
	INC	HL		; next character
	DJNZ	PFLNA1		; do 8 characters
	LD	A,'.'
	CALL	CTYPE
	LD	B,3		; 3 character file type
PFLNA2:	LD	A,(HL)		; get character
	CP	020H		; space ?
	CALL	NZ,CTYPE	; no - print the character
	INC	HL		; next character
	DJNZ	PFLNA2		; do 3 characters
	RET
;
; write a string of characters to the crt
;
ILPRT:	EX	(SP),HL		; save return address/get character pointer
ILPRT1:	LD	A,(HL)		; get a byte
	OR	A		; test it
	JR	Z,ILPRT2	; null - end of string
	CALL	CTYPE		; else type the character
	INC	HL		; next character
	JR	ILPRT1		; loop for more
ILPRT2:	EX	(SP),HL		; restore return address
	RET			; return to caller
;
CTYPE:	PUSH	AF		; save all registers
	PUSH	BC
	PUSH	DE
	PUSH	HL
	AND	07FH		; be sure its ascii
	LD	E,A		; into 'E'
	LD	C,6		; cpm direct console function
	CALL	5
	POP	HL		; restore all registers
	POP	DE
	POP	BC
	POP	AF
	RET			; return to caller
;
CRLF:	LD	A,13
	CALL	CTYPE
	LD	A,10
	JR	CTYPE
;
PUTRG	MACRO	
	PUSH	BC		; save bc, de, hl
	PUSH	DE
	PUSH	HL
	ENDM	
GETRG	MACRO	
	POP	HL		; restore hl, de, bc
	POP	DE
	POP	BC
	ENDM	
;
PNUMB0:
	PUSH	AF		; save all regs
	PUTRG	
	LD	A,1		; a=1
	LD	(LSFLG0),A	; turn on leading <sp>
	LD	(SPCFLG),A
	JR	PHDC
;
;
;	print hl as decimal characters w/leading spaces in 5-char field
;
PNUMB1:	PUSH	AF		; save all regs
	PUTRG	
	LD	A,1		; a=1
	LD	(LSFLG0),A	; turn on leading <sp>
	LD	A,0
	LD	(SPCFLG),A
;
PHDC:	LD	DE,1000		; print 1000'S
	CALL	PHDC1
	LD	DE,100		; print 100'S
	CALL	PHDC1
	LD	DE,10		; print 10'S
	CALL	PHDC1
	LD	A,L		; print 1'S
	ADD	A,'0'		; convert to ascii
	CALL	CTYPE
	GETRG			; restore all regs
	POP	AF
	RET	
;
LSFLG0:	DEFS	1		; leading <sp> flag
;	
;  divide hl by de and print quotient with leading <sp>s
;
PHDC1:	LD	C,0		; set count
PHDC2:	LD	A,L		; sub e from l
	SUB	E
	LD	L,A		; result in l
	LD	A,H		; sub d from h w/borrow
	SBC	A,D
	LD	H,A		; result in h
	JP	C,PHDC3		; done if carry set (further borrow)
	INC	C		; incr count
	JP	PHDC2
PHDC3:	LD	A,L		; add e to l
	ADD	A,E
	LD	L,A		; result in l
	LD	A,H		; add d to h w/carry
	ADC	A,D
	LD	H,A		; result in h
	LD	A,C		; get result
	OR	A		; check for zero
	JP	NZ,PHDC4
	LD	A,(LSFLG0)	; check for leading <sp>
	OR	A		; print value if not (a=0)
	JP	Z,PHDC4
	LD	A,(SPCFLG)
	OR	A
	RET	NZ
	LD	A,' '		; print <sp>
	CALL	CTYPE
	RET	
PHDC4:	XOR	A		; turn off leading <sp>
	LD	(LSFLG0),A
	LD	A,C		; get value
	ADD	A,'0'		; convert to ascii
	CALL	CTYPE
	RET	
;
SPCFLG:	DEFB	0
SECTRS:	DEFB	0,0,0
MAXNUM:	DEFW	0
MAXDIR:	DEFW	0
NAMBUF:	DEFW	0
MEMBRS:	DEFW	0
DIRS:	DEFB	0		; # of dir sectors processed
DIRSIZ:	DEFB	0		; # of total dir sectors
COL:	DEFB	0		; column count
SUPSPC:	DEFB	0
TBLOC:	DEFW	0
COUNT:	DEFW	0
SCOUNT:	DEFW	0
GAP:	DEFW	0
VARI:	DEFW	0
VARJ:	DEFW	0
VARJG:	DEFW	0
FCB1:	DEFS	36
	DEFS	50		; 25 level stack
STACK:	DEFW	0		; save cp/m stack pointer here
ORDER	EQU	$
;
	END