RomWBW/Source/Images/d_bp/u15/XD.MAC

;
;  PROGRAM:  XD III
;  AUTHOR:  RICHARD CONN
;  VERSION:  1.2
;  DATE:  8 Apr 84
;  PREVIOUS VERSIONS:  1.1 (14 Jan 84), 1.0 (19 Nov 83)
;  DERIVATION:  XDIR III, Version 1.6 (19 Nov 83)
;
vers	equ	12
z3env	SET	0f400h

;
;  XD III -- Simple Extended Disk Directory Program
;		ZCPR3 Only
;
;	XD III produces a formatted, alphabetized listing of the contents
; of the disk directory of the implied (current logged-in) or specified disk.
;
;	XD III is invoked by a command line of the following form --
;
;		XD dir:filename.typ ooo...
; or
;
;		XD /oooo...
;
; where:
;	dir is an optional directory name or a disk/user specification (du)
;	if dir is omitted, XD III defaults to the current disk/user
;	filename.typ is an ambiguous file name and type (* and ? may be used)
;	o are option letters as follows:
;		Aa - Set the attributes of the files to be displayed;
;			a=S for System Files, a=N for Non-System Files
;			a=A for All Files (System and Non-System)
;		Oo - Set Output Parameters;
;			o=A to Toggle File Attributes, o=F to Form Feed at end
;			o=G to Toggle Grouping, o=H to Toggle Hor/Vert
;		P  - Print display as well as show it on the screen
;		PF - Same as POF
; Options may be combined as desired; note that AA is the same as AS and AN,
; but AS by itself negates AN and vice-versa, with AN taking precident
;


;
;  CP/M Equates
;
base	equ	0
wboot	equ	base
bdose	equ	base+5
fcb	equ	base+5ch
buff	equ	base+80h
cr	equ	0dh
ff	equ	0ch
lf	equ	0ah
esize	equ	16	; size of directory entries
optch	equ	'/'	; option char
maxent	equ	60	; maximum number of entries/screen

;
;  External Routines
;
	ext	bdos	; BDOS
	ext	z3init	; init ZCPR3 environment descriptor ptr
	ext	z3log	; log into ZCPR3 DU/DIR
	ext	dirqs	; quick directory load with sizes
	ext	dfree	; free space computer
	ext	dparam	; disk parameter extractor
	ext	fsize	; compute file size
	ext	retud	; get current user and disk
	ext	print	; print routines
	ext	pstr
	ext	lcrlf	; CRLF to printer
	ext	caps	; capitalize char
	ext	cin	; console in char
	ext	lout	; print char
	ext	cout	; console out char
	ext	crlf	; new line
	ext	fillb	; memory fill
	ext	moveb	; memory move
	ext	codend	; beginning of buffer area
	ext	sctlfl,sout,scrlf,sprint,spstr,shldc,sadc	; S-output
	ext	dutdir	; DU to DIR form

;
; Environment Definition
;
	if	z3env ne 0
;
; External ZCPR3 Environment Descriptor
;
	jmp	start
	db	'Z3ENV'	;This is a ZCPR3 Utility
	db	1	;External Environment Descriptor
z3eadr:
	dw	z3env
start:
	lhld	z3eadr	;pt to ZCPR3 environment
;
	else
;
; Internal ZCPR3 Environment Descriptor
;
	MACLIB	Z3BASE.LIB
	MACLIB	SYSENV.LIB
z3eadr:
	jmp	start
	SYSENV
start:
	lxi	h,z3eadr	;pt to ZCPR3 environment
	endif

;
; Start of Program -- Initialize ZCPR3 Environment
;
	call	z3init	;initialize the ZCPR3 Env
;
;  Branch to Start of Program
;
	jmp	start0

;
;  Other Buffers (Set by GENINS)
;
igrp:	db	0ffh	; Group by file type and name
ifmt:	db	0	; vertical format
iatt:	db	10000000b	; Non-System files only
irs:	db	0ffh	; enable attribute display (0=no)
iff:	db	0	; enable form feed at end (0=no)

;
;  Command Line Option Table
;
optab:
	db	'A'	; Attribute Selection
	dw	opta
	db	'O'	; Output Control
	dw	opto
	db	'P'	; Print Control
	dw	optp
	db	0

;
;  **** Start of XD III ****
;
start0:

;  Save stack ptr for return later
	lxi	h,0	; get stack
	dad	sp
	shld	stack	; save stack ptr for return
	call	codend	; determine free space (CODEND also pts to Command
			;   Line Save Area)
	lxi	d,100h	; block size to save
	dad	d
	dad	d	; allow for 256-byte stack
	shld	buffer	; start of free buffer area
	sphl		; set stack ptr

;  Save command line in CMDLNE buffer
	call	codend	; pt to command line buffer
	xchg		; ... in DE
	lxi	h,buff+1	; copy input line into command line buffer
start1:
	mov	a,m	; get byte
	stax	d	; put byte
	inx	h	; pt to next
	inx	d
	ora	a	; end of line?
	jnz	start1

;  log into DU or DIR
	lxi	d,fcb	; extract file name into fcb, and get user and disk
	call	z3log	; ZCPR3 command line interpretation

;  Get and save current user number
noext:
	call	retud	; get current user and disk
	mov	a,c	; get user into A
	sta	aflg	; current user number

;  Set flag values
	lda	irs	; get RS display option
	sta	rsflg	; set RS display option
	lda	iff	; get form feed option
	sta	ffflg	; set form feed option
	lda	igrp	; set grouping (file name/type or type/name)
	sta	gflg
	lda	ifmt	; set listing format (vertical or horizontal, 0=vert)
	sta	hflg
	lda	iatt	; set file attributes
	mov	c,a	; save in c
	lda	aflg	; get current user number
	ora	c	; mask in file attributes
	sta	aflg	; save flag
	xra	a	; A=0
	sta	pflg	; set no printer output
	inr	a	; A=1 for console only
	sta	sctlfl	; set switched output flag

;  Assume wild file name
	lxi	h,fcb+1	; store '?' chars
	mvi	b,11	; 11 chars
	mov	a,m	; check for entry specified
	cpi	' '	; test for space (means no entry)
	mvi	a,'?'	; prep for '?' fill
	cz	fillb
	mov	a,m	; check for option caught
	cpi	optch	; test for option flag
	mvi	a,'?'	; prep for '?' fill
	cz	fillb

;  Scan command line for options
	call	codend	; pt to first char
	call	sblank	; skip over blanks
	ora	a	; end of line?
	jz	xdir	; begin main processing
	inx	h	; prep for invalid option
	cpi	optch	; option?
	jz	opt	; process options
	dcx	h	; ok to process for dir:filename.typ form
;
;  Skip over characters of file name
;
skipo1:
	mov	a,m	; get char
	inx	h	; pt to next
	cpi	' '
	jz	skipo2
	ora	a
	jnz	skipo1
	jmp	xdir	; run XDIR if no options follow
;
;  Scan complete -- look for possible following option char
;
skipo2:
	call	sblank	; skip over blanks
	mov	a,m	; option char follows?
	cpi	optch
	jnz	opt
	inx	h	; skip over option char
;
;  Look for options -- main loop; HL pts to next char
;
opt:
	mov	a,m	; get option char
	inx	h	; pt to next
	ora	a	; end of line?
	jz	xdir	; begin main processing
	cpi	' '	; skip over spaces
	jz	opt
	cpi	optch	; option char?
	jz	opterr	; loop back if so
	lxi	d,optab	; pt to option table
	mov	b,a	; option char in b
;
;  Scan option table
;
opt1:
	ldax	d	; get option table char
	ora	a	; end of table?
	jz	opterr	; invalid option error
	cmp	b	; compare to passed option
	jz	opt2	; process if match
	inx	d	; skip address
	inx	d
	inx	d	; pt to next opt char
	jmp	opt1
;
;  Process option found
;
opt2:
	inx	d	; pt to low-order address
	ldax	d	; get it
	mov	c,a	; low in C
	inx	d	; pt to high-order address
	ldax	d	; get it
	mov	b,a	; high in B
	push	b	; BC on stack
	ret		; Process option routine
;
;  Option A -- File Attributes
;
opta:
	mov	a,m	; get next option letter
	cpi	'N'	; Non-System files?
	jz	optan
	cpi	'S'	; System files?
	jz	optas
	cpi	'A'	; All files?
	jnz	opterr	; error if not
;
;  Option AA -- All Files
;
optaa:
	mvi	c,11000000b	; System and Non-system
optaret:
	lda	aflg	; get flag
	ani	3fh	; leave in user selection
	ora	c	; mask in sys/non-sys
	sta	aflg	; restore flag
	inx	h	; pt to next
	jmp	opt
;
;  Option AS -- System Files
;
optas:
	mvi	c,01000000b	; System Only
	jmp	optaret
;
;  Option AN -- Non-System Files
;
optan:
	mvi	c,10000000b	; Non-system Only
	jmp	optaret
;
;  Option P -- enable it; Printer output
;
optp:
	mvi	a,0ffh	; ON
	sta	pflg
	sta	sctlfl	; set S-output control
	mov	a,m	; get possible 2nd letter
	cpi	'F'	; set form feed if F
	jnz	opt	; process as next option letter if not F
	inx	h	; pt to next
	jmp	optof
;
;  Option O -- control Output parameters
;
opto:
	mov	a,m	; get 2nd letter
	inx	h	; pt to next
	cpi	'A'	; attributes?
	jz	optoa
	cpi	'F'	; form feed?
	jz	optof
	cpi	'G'	; grouping?
	jz	optog
	cpi	'H'	; horizontal/vertical?
	jz	optoh
	dcx	h	; adjust back
	jmp	opterr
;
;  Toggle File Attributes Flag
;
optoa:
	lda	rsflg	; flip flag
	cma
	sta	rsflg
	jmp	opt
;
;  Toggle Form Feed Flag
;
optof:
	lda	ffflg	; flip flag
	cma
	sta	ffflg
	jmp	opt
;
;  Toggle Grouping
;
optog:
	lda	gflg	; flip flag
	cma
	sta	gflg	; 0=file name and type
	jmp	opt
;
;  Toggle Horizontal/Vertical Listing
;
optoh:
	lda	hflg	; flip flag
	cma
	sta	hflg	; 0=vertical
	jmp	opt
;
;  Option error message
;
opterr:
	mvi	a,1	; set console only
	sta	sctlfl	; set output control flag
	call	banner	; print banner
	call	print
	db	cr,lf,'Syntax:'
	db	cr,lf,'	XD dir:filename.typ ooo...'
	db	cr,lf,'or	XD /oooo...'
	db	cr,lf,'Option letters are:'
	db	cr,lf,'	Aa - Set and Display of file attributes'
	db	cr,lf,'	  a=S for System, a=N for Non-System'
	db	cr,lf,'	  a=A for All Files (System and Non-System)'
	db	cr,lf,'	Oo - Toggle Output Control Options'
	db	cr,lf,'	  o=A for File Attributes, o=F for Form Feed'
	db	cr,lf,'	  o=G for Grouping, o=H for Horiz/Vert Format'
	db	cr,lf,'	P  - Send display to printer'
	db	cr,lf,'	PF - Same as POF'
	db	0

;  Return to CP/M
return:
	lhld	stack	; get old stack ptr
	sphl
	ret		; return to CP/M

;  Memory Overflow Error
memerr:
	call	sprint
	db	'TPA Error',0
	jmp	return

;  Print banner of XD III
banner:
	call	sprint
	db	'XD III  Version '
	db	vers/10+'0','.',(vers mod 10)+'0',0
	ret

;
;  Begin XD III processing
;
xdir:
	lxi	d,fcb	; pt to FCB
	xra	a
	stax	d	; select current disk

;  Check for Print Option and Print New Line if so
xdirst:
	lda	pflg	; printer output?
	ora	a	; 0ffH=yes
	cnz	lcrlf	; new line

;  Get Files from Disk
	push	d	; save ptr to FCB
	call	dparam	; get disk parameters for DFREE
	call	dfree	; compute amount of free space on disk
	xchg		; amount in hl
	shld	freesiz	; save free space count
	pop	d	; get regs
	lhld	buffer	; pt to free space
	lda	gflg	; get grouping flag
	ani	20h	; mask for sort bit (0=name/type)
	mov	c,a
	lda	aflg	; get attributes flag
	ora	c	; mask in grouping bit
	call	dirqs	; quick directory load with file sizes
	jz	memerr	; memory overflow error?
	shld	firstf	; save ptr to first file
	mov	h,b	; HL=file count
	mov	l,c
	shld	fcount	; save file count
	shld	countf	; save file down count
	lxi	h,0	; set file size counter
	shld	totsiz	; save counter
	lda	pflg	; set temp flag
	sta	pflgt

;
;  Main Directory Print Routine -- This routine displays the directory to
;  the console, printer, or disk as desired
;
;  Print header lines and one screen of entries
xdir2:
	lda	pflg	; save printer output flag
	sta	pflgs
	lda	pflgt	; use temp flag
	sta	pflg
	xra	a	; A=0
	sta	pflgt	; clear temp flag

;  Print: Main Banner
	call	banner	; print banner

;  Check for any files
	lhld	countf	; get file down count
	mov	a,h	; any files?
	ora	l
	jnz	xdir6
	call	sprint	; print everywhere
	db	cr,lf,'No files selected',0
	jmp	xdir10

;
;  This is the main looping entry point for each screen display
;
xdir6:
;
;  This is the header which is printed if the files in only one user area are
;    displayed
;
	call	scrlf	; specific user selected
	call	hdr2
	lda	rsflg
	ora	a	; Z=no
	cnz	sp0
	call	sp2
	call	hdr2
	lda	rsflg
	ora	a	; Z=no
	cnz	sp0
	call	sp2
	call	hdr2
	lda	rsflg
	ora	a
	cnz	sp0
	call	scrlf
	call	hdr1
	lda	rsflg
	ora	a
	cnz	sp1
	call	sp2
	call	hdr1
	lda	rsflg
	ora	a
	cnz	sp1
	call	sp2
	call	hdr1
	lda	rsflg
	ora	a
	cnz	sp1
	jmp	xdir6b
sp0:
	call	sprint
	db	' RS',0
	ret
sp1:
	call	sprint
	db	' --',0
	ret
sp2:
	call	sprint
	db	'  ',0
	ret
hdr1:
	call	sprint
	db	'-------- --- ------',0
	ret
hdr2:
	call	sprint
	db	'Filename.Typ Size K',0
	ret

;
;  Prepare Columnar Output
;
xdir6b:
	lda	pflgs	; restore print flag
	sta	pflg
	lhld	countf	; get file count down
	lxi	d,maxent	; assume maxent entries to print
	mov	a,h	; within range?
	ora	a	; outside of range if not
	jnz	xdir7	; subtract entries to print from total entries
	mov	a,l	; within range?
	cpi	maxent	; less than maxent entries left?
	jnc	xdir7	; subtract entries to print from total entries
	mov	d,h	; DE=HL=number of entries to print
	mov	e,l
xdir7:
	mov	a,l	; subtract entries to print (DE) from total (HL)
	sub	e
	mov	l,a
	mov	a,h
	sbb	d
	mov	h,a	; HL=result
	shld	countf	; save new down count
	mov	b,h	; BC=count
	mov	c,l
	lhld	firstf	; pt to first file
;
;  At this point, BC=number of remaining entries, DE=number of entries to
;    print, and HL pts to first entry to print
;
	shld	ptr1	; save ptr to 1st entry
	lda	hflg	; horizontal listing?
	ora	a	; 0ffh = yes
	jnz	xdir7c	; don't worry about columns if horizontal
	push	d	; save count
	call	divde3	; divide DE by 3, result*esize in BC, remainder in A
	lxi	d,esize	; DE=ESIZE (size of entry)
	dad	b	; add BC as a minimum
	ora	a	; any remainder?
	jz	xdir7a	; skip if none
	dad	d	; add in ESIZE for additional length of 1st col
xdir7a:
	shld	ptr2	; save ptr to col 2
	dad	b	; add BC as a minimum
	cpi	2	; if remainder 2, add ESIZE for additional
	jc	xdir7b
	dad	d	; add in ESIZE
xdir7b:
	shld	ptr3	; save ptr to col 3
	pop	d	; get count in de
;
;  Main entry print routine
;
xdir7c:
	mvi	d,1	; set 3's counter
xdir8:
	lhld	ptr1	; pt to first entry
	call	prentry	; print entry
	shld	ptr1	; put ptr
	lda	hflg	; horizontal?
	ora	a	; 0ffh = yes
	jnz	xdir9
	dcr	e	; count down
	jz	xdir10
	lhld	ptr2	; get ptr
	call	prentsp	; print entry with 2 leading spaces
	shld	ptr2	; put ptr
	dcr	e	; count down
	jz	xdir10
	lhld	ptr3	; get ptr
	call	prentsp	; print entry with 2 leading spaces
	shld	ptr3	; put ptr
xdir9:
	dcr	e	; count down
	jnz	xdir8	; continue if not zero
	shld	firstf	; save ptr to first of next set of entries to print
	lhld	countf	; get count of remaining entries
;
;  At this point, HL=number of entries left
;
	mov	a,h	; anything left?
	ora	l
	jz	xdir10
	lda	pflg	; printer output?
	ora	a	; 0=no
	jnz	xdir6
	call	print	; screen break
	db	cr,lf,' --> Screen Break -- Strike any char <-- ',0
	call	cin	; get response
	cpi	3	; abort?
	jz	return
	jmp	xdir6	; new screen display
;
;  Print end statistics and exit
;
xdir10:
;
;  Print DU
;
	call	sprint	; print everywhere
	db	cr,lf,'     ',0
	call	retud	; get current disk
	mov	a,b	; ... in A
	adi	'A'	; convert to ASCII
	call	sout	; print everywhere
	mov	a,c	; user in A
	call	sadc	; get number
	call	sprint
	db	': ',0
	call	dutdir	; convert to DIR form
	jz	xdir11
;
;  Print DIR Name
;
	mvi	b,8	; output name
dirout:
	mov	a,m	; get char
	cpi	' '	; don't print spaces
	cnz	sout
	inx	h	; pt to next
	dcr	b	; count down
	jnz	dirout

;
;  Print Selected File Statistics
;
xdir11:
	call	sprint
	db	' --',0
	lhld	fcount	; print file count
	call	shldc	; print it everywhere
	call	sprint
	db	' Files Using ',0
	lhld	totsiz	; get total of file sizes
	call	shldc	; print it everywhere
	call	sprint
	db	'K',0

;
;  Print Space Remaining on Disk
;    Entry Point if No Files Found
;
	call	sprint
	db	' (',0
	lhld	freesiz	; get amount of free space
	call	shldc	; print it everywhere
	call	sprint
	db	'K Left)',0
	lda	pflg	; new line if printer output
	ora	a
	jz	return
	call	scrlf	; new line for printer
	lda	pflg	; print output
	mov	b,a
	lda	ffflg	; form feed
	ana	b	; if print and form feed ... NZ is set
	mvi	a,ff	; form feed char
	cnz	lout	; form feed to printer
	jmp	return

;
;  General Utility Routines
;

;
;  Print disk entry for normal directory display functions
;
prentsp:
	call	sp2	; print entry with 2 leading spaces
prentry:
	dcr	d	; count <CRLF> counter
	jnz	prent1
	mvi	d,3	; reset count
	call	scrlf
prent1:
	shld	entptr	; save entry ptr
	inx	h	; pt to first char of file name
	mvi	b,8	; print 8 chars
	call	prch
	mvi	a,'.'	; print dot
	call	sout
	push	h	; save RS ptr
	mvi	b,3	; print 3 chars
	call	prch
	push	d	; save de
	lhld	entptr	; pt to entry
	call	sp2	; skip 2 spaces
	call	fsize	; compute file size
	lhld	totsiz	; get total file size counter
	dad	d	; add in new file
	shld	totsiz	; save new total file size counter
	xchg		; get file size into HL
	call	shldc	; print HL value
	pop	d	; get de
	pop	h	; pt to RS
	lda	rsflg	; print RS fields?
	ora	a	; Z=no
	jz	pren2a
	mvi	a,' '	; print 1 space
	call	sout
	mvi	b,'R'	; letter
	call	prletx	; print R if bit set
	inx	h
	mvi	b,'S'	; letter
	call	prletx	; print S if bit set
	dcx	h	; ... for following inx h
pren2a:
	inx	h	; point correctly
prent3:
	lxi	b,6	; pt to next entry
	dad	b
	ret
;
;  Print B chars pted to by HL
;
prch:
	mov	a,m	; get char
	inx	h	; pt to next
	ani	7fh	; mask out msb
	cpi	' '	; within range?
	jnc	prch1	; print special char if not valid char
	mvi	a,'?'	; print ? if not valid char
prch1:
	call	sout	; print it
	dcr	b	; count down
	jnz	prch
	ret
;
;  Extended Print Routines
;
prletx:
	mov	a,m	; get byte
	ani	80h	; look at msb
	jz	prlets
	mov	a,b	; get letter
	jmp	sout
prlets:
	mvi	a,' '	; print <sp>
	jmp	sout
;
;  Divide DE by 3; return with BC=result*esize, a=remainder
;
divde3:
	push	d	; save de, hl
	push	h
	mvi	d,0	; make sure D=0
	mov	a,e	; value in A
divd31:
	sui	3	; subtract 3
	jc	divd32
	jz	divd33
	inr	d	; add 1 to result
	jmp	divd31
divd32:
	adi	3	; add back in
	jmp	divd34
divd33:
	inr	d	; add 1 for even division
divd34:
	sta	rem	; save remainder
	lxi	b,esize
	lxi	h,0
divd35:
	mov	a,d	; done?
	ora	a	; 0=yes
	jz	divd36
	dcr	d
	dad	b	; add in another ESIZE
	jmp	divd35
divd36:
	mov	b,h	; BC is result
	mov	c,l
	lda	rem	; A is remainder
	pop	h	; restore regs
	pop	d
	ret
;
;  Skip blanks
;
sblank:
	mov	a,m	; pt to char
	cpi	' '	; blank?
	rnz
	inx	h	; pt to next
	jmp	sblank

;
;  Buffers
;
aflg:	ds	1	; attibute flag
gflg:	ds	1	; 0=group by name/type
hflg:	ds	1	; 0=vertical list
pflg:	ds	1	; printer output on flag
crcnt:	ds	1	; entry counter
fmark:	ds	1	; first file marker
pflgt:	ds	1
pflgs:	ds	1
rsflg:	ds	1	; RS Display Flag
ffflg:	ds	1	; form feed flag
rem:	ds	1	; remainder buffer
firstf:	ds	2	; ptr to first file of group to print
fcount:	ds	2	; count of files
countf:	ds	2	; down count of files
freesiz:
	ds	2	; amount of free space on disk
totsiz:
	ds	2	; total size of all files
ptr1:	ds	2	; col output ptrs
ptr2:	ds	2
ptr3:	ds	2
entptr:	ds	2	; current entry ptr
buffer:	ds	2	; pointer to free area
stack:	ds	2	; stack ptr

	end