;
;		    Simple Sorted Directory, Remote Version
;				    (SSDR)
;				  version 1.1
;
;	This program is one of three designed to do, basically, what  SD
;	does,  but  without  the overhead.  This program is designed for
;	remote systems (RCP/M's).  It uses the baud rate flag placed  at
;	3c  Hex  by  BYE to determine the XMODEM send times of each file
;	and displays it next to the file name and size.   It  also  uses
;	the  WHEEL  byte  (3e  Hex)  to  restrict  access to the D and S
;	options to when the wheel is set (i.e. when a SYSOP  is  on  the
;	system.)    Files  with  the  system  flag set are shown with an
;	asterisk in place of the period between  filename  and	filetype
;	(i.e. DUMMY   *FIL).   See SSD.DOC for more detailed information
;	about this program and the other two (SSD and VSD).
;
;	This program cannot be assembled with ASM due to the  fact  that
;	ASM doesn't accept negative numbers with LXI and MVI statements.
;	MAC works fine, as should RMAC.
;
;
;
true	equ	0ffh
false	equ	not true
;
vers	equ	1		;version
rev	equ	1		;revision
;
month	equ	05		;date of last revision
day	equ	09		; /
year	equ	86		;/
;
cr	equ	13		;carriage return
lf	equ	10		;line feed
tab	equ	9		;tab
;
maxdrv	equ	3dh		;location of ZCPR max user-area byte
wheel	equ	3eh		;ZCPR wheel byte
maxusr	equ	3fh		;ZCPR maxuser byte
speed	equ	3ch		;location where BYE stuffs baud rate
;
base	equ	0		;base of CP/M
dfcb	equ	5ch		;CP/M default FCB
ddma	equ	base+80h	;CP/M default DMA
;
bdos	equ	base+5		;BDOS vector
dircon	equ	6		;BDOS direct console I/O
pstring equ	9		;BDOS print string
resetd	equ	13		;BDOS reset disks
setd	equ	14		;BDOS select disk
searchf equ	17		;BDOS search for first occurance of file
searchn equ	18		;BDOS search for next occurance of file
getd	equ	25		;BDOS get drive #
setdma	equ	26		;BDOS set DMA address
galloc	equ	27		;BDOS get address of allocation vector
curdpb	equ	31		;BDOS get current disk parameters
userst	equ	32		;BDOS get/set user #
;
	org	base+100h
;
	jmp	start		;jump past following data
;
numcol: db	3		;# of columns
numlin: db	23		;# of lines on screen - 1
;
start:	lxi	h,0		;zero HL
	dad	sp		;get stack pointer
	shld	oldsp		;put it away
	lxi	sp,stack	;...and initialize local stack
;
	mvi	a,0ffh		;turn off PCHAR paging
	sta	pgflg
	call	print		;newline
	db	cr,lf,0
;
;	Clear data bytes, making program re-entrant
;
	mvi	b,datend-defd	;# of bytes to clear
	lxi	h,defd		;place to start clearing
cllop:	mvi	m,0		;clear byte at (HL)
	inx	h		;bump pointer
	dcr	b		;decrement counter
	jnz	cllop		;if not done, clear the next one
;
	lda	numcol		;# of columns
	sta	column		;store it
	lda	numlin		;# of lines
	sta	row		;store it
;
	lda	speed		;get baud rate indicator
	sta	baud		;save it
;
;
	mvi	c,getd		;get default drive
	call	bdos
	sta	defd		;save it
	mvi	c,userst	;get default user
	mvi	e,0ffh
	call	bdos
	sta	defu		;save it
;
;	Check the selected drive (if any) against the maximum allowed by
;	ZCPR
;
	lda	dfcb		;get any selected drive
	ora	a		;zero?
	jz	snfopt		;if so, then default drive, no problem
;
	push	psw		;save selected drive
	lda	maxdrv		;get max drive
	inr	a
	inr	a		;for compare
	mov	b,a		;/
	pop	psw		;restore selected drive
	cmp	b		;compare to max drive
	jnc	drverr		;error out if illegal drive
;
;	Search FCB filename for a $ denoting options.  If one exists,
;	clear FCB by making first byte a space.
;
snfopt: lxi	h,dfcb+1	;point to first byte of FCB filename
	mvi	b,11		;# of bytes to check
snfopt1:mov	a,m		;get byte at (HL)
	cpi	'$'		;dollar sign?
	jnz	snfo1		;no? then try next byte
	mvi	a,20h		;there's a $ sign in the FCB.  Get a space...
	sta	dfcb+1		;...make it the first byte of the filename
	jmp	clrfcb		;...and break out of the loop
snfo1:	inx	h		;wasn't a $, bump pointer
	dcr	b		;...tweak counter
	jnz	snfopt1 	;...and try again if we're not done
;
;	Clear the FCB of all but drive, filename
;
clrfcb: lxi	h,dfcb+12	;end of filename buffer
	mvi	b,24		;# of bytes to clear
clrlp:	mvi	m,0		;zero out (HL)
	inx	h		;bump pointer
	dcr	b		;decrement counter
	jnz	clrlp		;do the next byte if we're not done
;
;	Check the command-line buffer (in the DMA) for any options
;
	lxi	h,ddma		;beginning of buffer
	mov	a,m		;get character count
	ora	a		;zero?
	jz	dodir		;if so, no options
	inx	h		;point past count
	push	h		;save pointer
	mvi	d,0		;get count in DE
	mov	e,a		;/
	dad	d		;add to HL
	mvi	m,0		;make last byte of buffer a null
	pop	h		;point back to beginning of buffer
	dcx	h		;for INX to follow
;
getlp:	inx	h		;point to first/next byte of command-line
	mov	a,m		;get a byte
	cpi	'$'		;option delimeter?
	jz	doopt		;if so, handle it appropriately
	ora	a		;null terminator?
	jnz	getlp		;if not a null or a $, try again
;
dodir:	lda	dfcb+1		;get first byte of filename
	cpi	20h		;space?
	cz	qfill		;fill with ?'s
;
	mvi	a,'?'		;force wild extent
	sta	dfcb+12 	;/
	call	setsrc		;set DMA for BDOS media change check
	lxi	h,dfcb		;point to drive code for directory
	mov	a,m		;get the drive code out of the FCB
	ora	a		;zero?
	jz	deflt		;then don't change the drive
	mov	e,a		;else move to E for BDOS
	dcr	e		;normalize drive code for select
	mvi	c,setd		;select the directory drive to retrieve
	call	bdos		;...the proper allocation vector
;
deflt:	mvi	c,curdpb	;request DPB
	call	bdos		;/
	inx	h
	inx	h
	mov	a,m		;get block shift
	sta	blkshf		;save it
	inx	h		;bump to block mask
	mov	a,m		;get it
	sta	blkmsk		;save it
	inx	h
	inx	h
	mov	e,m		;get max block number
	inx	h
	mov	d,m
	xchg
	shld	blkmax		;save it
	xchg
	inx	h
	mov	e,m		;get directory size
	inx	h
	mov	d,m
	xchg
	shld	dirmax		;save it
	mvi	c,galloc	;get address of allocation vector
	call	bdos
	xchg
	lhld	blkmax		;get it length
	inx	h
	lxi	b,0		;init block count to zero
;
gspbyt: push	d		;save alloc address
	ldax	d
	mvi	e,8		;set to process 8 blocks
;
gsplup: ral			;test bit
	jc	notfre
	inx	b
;
notfre: mov	d,a		;save bits
	dcx	h		;count down blocks
	mov	a,l
	ora	h
	jz	endalc		;quit if out of blocks
	mov	a,d		;restore bits
	dcr	e		;count down 8 bits
	jnz	gsplup		;do another bit
	pop	d		;bump to next byte...
	inx	d		;of allocation vector
	jmp	gspbyt		;process it
;
endalc: pop	d		;clear stack
	mov	l,c		;copy blocks to HL
	mov	h,b
	lda	blkshf		;get block shift factor
	sui	3		;convert from sectors to k
	jz	savfre		;skip shifts if 1k blocks ret free in HL
;
freklp: dad	h		;multiply blocks by k/blk
	dcr	a
	jnz	freklp
savfre: shld	freeby		;save free disk space
	mvi	a,'?'
	lxi	h,dfcb+12
	mov	m,a		;match all extents
	inx	h
	mov	m,a		;match all S1 bytes
	inx	h
	mov	m,a		;match all S2 bytes
	call	setsrc		;set DMA for directory search
;
;	Calculate total storage capacity of disk -system and directory tracks
;
	lhld	dirmax		;get total # of directory entries
	inx	h
;
	lxi	d,-32		;prepare to divide HL by 32
	mvi	b,0		;initialize counter
;
dvlp:	dad	d		;subtract
	jnc	dvex		;exit if overflow
	inr	b		;otherwise, bump counter
	jmp	dvlp		;subtract again
;
dvex:	mov	a,b		;get value in A
	sta	dirspc		;...for save
;
	lda	blkmsk		;get block mask
	rar			;rotate right 3 times
	rar
	rar
	ani	00011111b	;clear any crud
	inr	a		;add one to get block size
	mov	b,a		;to B to act as counter
;
	lhld	blkmax		;get max # of blocks
	inx	h		;normalize
	mov	d,h		;move HL->DE
	mov	e,l		;/
mullp:	dcr	b		;bump down counter
	jz	mulex		;if done, exit
	dad	d		;add HL to itself
	jmp	mullp
;
mulex:	push	h		;save # of k on disk
	lda	dirspc		;get directory space back
	mov	b,a		;for count
	lxi	d,0		;initialize DE
nloop:	dcx	d		;decrement DE
	dcr	b		;ditto for B
	jnz	nloop		;if not done, decrement another
	dad	d		;subtract directory space
	shld	totfre		;save it
;
;	Allocate order table for sort
;
	lhld	dirmax		;get directory maximum
	inx	h		;dirmax+1 is directory size
	dad	h		;double it to get size of order table
	lxi	d,order		;get beginning of order table
	dad	d		;point to beginning of name table
	shld	filebuf		;save it
	shld	optr		;initialize pointer
	xchg
	lhld	bdos+1		;make sure we have room to continue
	mov	a,e
	sub	l
	mov	a,d
	sbb	h
	jnc	outmem
;
	lxi	d,dfcb		;point to filename fcb
	mvi	c,searchf	;search for first occurance
	call	bdos		;/
;
	inr	a		;FFh returned?
	jz	nofile		;nofile error message
	dcr	a		;else set A straight
	call	sfilen		;and print the filename info
;
floop:	mvi	c,searchn	;find next occurance of file
	call	bdos		;/
	inr	a		;FFh returned?
	jz	pfiles		;print files and quit if so
	dcr	a		;...else set A straight
	call	sfilen		;store the filename info
	jmp	floop		;do it again
;
pfiles: lhld	numfls		;get # of files read
	mov	a,h		;zero?
	ora	l		;/
	jz	nofile		;then print 'no files' and exit
;
	mvi	a,1		;be sure not to suppress leading spaces
	sta	supspc		;...through decprt
;
	call	sort		;sort filenames
	lxi	h,order		;point to beginning of order table
	shld	optr		;save pointer
	xchg			;order table pointer to DE
	lhld	numfls		;get # of files
	inx	h		;for first decrement
	shld	count		;save as file count
pf1:	lhld	count		;get file count
	dcx	h		;bump down
	shld	count		;save it
	mov	a,h		;done?
	ora	l		;/
	jz	rcur		;exit if so
	lhld	optr		;get pointer
	push	h		;save it
	lhld	count		;get the file count
	dcx	h		;decrement
	mov	a,h		;is this the last file?
	ora	l		;/
	pop	h		;restore pointer
	jz	okprt		;if the last file, go ahead and print
	mvi	a,11		;# of bytes to compare
	call	comp		;do it
	jnz	okprt		;if they don't match then it must be ok
	inx	h		;point to next entry
	inx	h
	shld	optr		;save new pointer
	jmp	pf1
;
okprt:	lhld	optr		;get pointer
	mov	e,m		;get filename pointer
	inx	h
	mov	d,m
	inx	h
	shld	optr		;save new order table pointer
	xchg
	push	h		;save fn ptr
	call	pfn		;print filename
	pop	h		;restore pointer
	lxi	d,11		;offset to filesize
	dad	d		;add it
;
	push	h		;save pointer
	mov	d,m		;...else get records in DE
	inx	h
	mov	e,m
	lhld	totrec		;get total records counter
	dad	d		;add this file's records
	shld	totrec		;save it
	pop	h		;get old pointer back
	push	d		;save file's record count
;
	call	doit		;convert to k
	lhld	totsiz		;get old total size count
	dad	d		;add this file's size to it
	shld	totsiz		;save new value
	lhld	totfil		;get old total files count
	inx	h		;increment
	shld	totfil		;save new value
	xchg			;DE->HL
;
	lda	recflg		;filesizes in records?
	ora	a		;/
	jz	prntfs		;if not, treat as for k
	mvi	a,20h		;else print an extra space
	call	pchar		;/
	pop	h		;...and get record size back in HL
	push	h		;save it again
;
prntfs: call	decprt		;print file size
;
	lda	recflg		;filesizes in records?
	ora	a		;/
	jnz	nok		;if so, don't print the 'k'
	mvi	a,'k'		;print a "k"
	call	pchar		;/
nok:	pop	h		;clear stack in case there's no baud specified
	lda	baud		;get baud indicator
	cpi	10		;make sure it's within legal range
	jnc	notim		;if not, don't print time
	mvi	a,20h		;print a space
	call	pchar
	call	filtim		;compute sendtime from record count in HL 
	push	h		;save seconds
	mov	l,c		;get minutes in HL
	mov	h,b
	call	udd		;print in ASCII
	mvi	a,':'		;...a colon
	call	pchar		;/
	pop	h		;restore seconds
	mov	a,l		;to A for subroutine
	call	uddzp		;print with zero pad
notim:	call	newcol		;new column
	jmp	pf1
;
newcol: lhld	count		;get file count
	dcx	h		;decrement
	mov	a,h		;last file?
	ora	l		;/
	rz			;simply return if so
;
	lda	column		;get column count
	dcr	a		;decrement
	jz	newlin		;if zero, start new line
	sta	column		;store it
;
	call	print		;print fence
	db	' |',0
	ret
;
newlin: call	print		;new line
	db	cr,lf,0 	;/
	lda	numcol		;get max # of columns
	sta	column		;re-initialize column count
	ret
;
rcur:	lda	column		;get column count
	ora	a		;cursor on new line?
	jz	noelf		;if so, no extra line feed
	call	print
	db	cr,lf,0
noelf:	call	print
	db	cr,lf,0
;
	xra	a		;supress leading spaces
	sta	supspc		;/
	call	pdu		;print DU:
	call	print
	db	20h,20h,0
	lhld	totfil		;get # of files displayed
	call	decprt		;print the #
	call	print
	db	' files occupying ',0
	lhld	numfls		;get total # of extents
	call	decprt		;print it
	mvi	a,'/'		;...a slash
	call	pchar		;/
	lhld	dirmax		;...get total # of entries allowed
	inx	h		;...normalize
	call	decprt		;...and print it
	call	print
	db	' extents in ',0
	lhld	totsiz		;get total K used by displayed files
	call	decprt		;print it
	call	print
	db	'/',0
	lhld	totfre		;get total free space
	call	decprt		;print it
	call	print
	db	'k (',0
;
	lhld	freeby		;get free space
	call	decprt		;print it
	call	print
	db	'k free)',cr,lf,0
;
	lda	baud		;get baud indicator
	cpi	10		;see if it's within legal range
	jnc	quit		;if not, quit now
;
	call	print
	db	'Total sendtime:  ',0
;
dtotst: lhld	totrec		;get total record count
	call	filtim		;compute sendtime
	push	h		;save seconds
	mov	h,b		;move minutes to HL
	mov	l,c		;/
	lxi	d,60		;...and divide by 60 to get hours
	call	dvhlde		;/
	push	h		;save minutes
	mov	h,b		;get hours in HL for print
	mov	l,c
	xra	a		;be sure to suppress spaces
	sta	supspc
	call	decprt		;print it
	mvi	a,':'		;...a colon
	call	pchar		;/
	pop	h		;get minutes back
	mov	a,l		;get 'em in A for print
	call	uddzp		;print with zero leadin
	mvi	a,':'		;a colon
	call	pchar		;/
	pop	h		;get seconds back
	mov	a,l		;to A for print
	call	uddzp		;print with zero leadin
;
	call	print
	db	' at ',0
	lda	baud		;get baud indicator
	lxi	h,sptbl 	;point to beginning of baudrate table
	mov	b,a		;for ADD to follow
	add	a		;multiply A x2
	add	a		;x4
	add	b		;x5
	add	b		;x6
	mov	e,a		;to DE for 16-bit add
	mvi	d,0		;/
	dad	d		;offset to baud rate in ASCII
	call	prhl		;print baud rate
	call	print
	db	' baud',cr,lf,0
	jmp	quit
;
outmem: call	print
	db	7,'ERROR - Out of Memory',cr,lf,0
	jmp	quit
;
drverr: call	print
	db	'Illegal drive',cr,lf,0
	jmp	quit
;
usrerr: call	print
	db	'Illegal user-area',cr,lf,0
	jmp	quit
;
nofile: call	print
	db	'No file(s) on ',0
;
	xra	a		;suppress leading spaces
	sta	supspc		;/
;
	call	pdu		;print DU:
	call	print
	db	' (',0
	lhld	freeby		;get disk free space
	call	decprt		;print it
	call	print
	db	'k free)',cr,lf,0
;
quit:	lda	defd		;get default drive back
	mov	e,a		;for BDOS operation
	mvi	c,setd
	call	bdos		;set it as new default
;
	lda	defu		;get old default user back
	mov	e,a		;for BDOS
	mvi	c,userst
	call	bdos		;set it as new default
;
	lhld	oldsp		;get old stack pointer back
	sphl			;set it
	ret			;to CP/M
;
;	Subroutines
;
;	SFILEN - store filename
;
sfilen: add	a		;perform (A x 32) + 1
	add	a		;x4
	add	a		;x8
	add	a		;x16
	add	a		;x32
	inr	a		;+1
;
	lxi	h,ddma		;point to default DMA
	mvi	d,0		;put offset in DE
	mov	e,a		;/
	dad	d		;add offset to HL
;
	lda	sysflg		;$SYS files to be displayed?
	ora	a		;/
	jnz	sf1		;if so, don't do the following
	push	h		;save pointer
	lxi	d,9		;offset to $SYS byte
	dad	d		;add to fname pointer
	mov	a,m		;get $SYS byte
	ani	80h		;will be zero if not $SYS
	pop	h		;restore stack
	rnz			;return if $SYS
;
sf1:	push	h		;save pointer
	lhld	optr		;get filename buffer pointer
	pop	d		;restore current filename pointer in DE
	xchg			;swap
	lxi	b,11		;# of bytes to move
	call	move		;move it
	xchg			;get new filename buffer pointer in HL
	inx	d		;DE->S1
	inx	d		;DE->S2
	ldax	d		;get S2 byte, overflow=int(extents/32)
	push	h		;save HL
	mov	l,a		;set up 16-bit multiply
	mvi	h,0
	mvi	b,5
	call	shll		;HL is now # of overflow extents
	dcx	d		;DE->S1
	dcx	d		;DE->extent
	ldax	d		;get extent
	add	l
	mov	l,a
	mov	a,h
	aci	0
	mov	h,a		;HL now has total sectors
	mvi	b,7
	call	shll		;HL now has total sectors less last ext
	inx	d		;DE->S1
	inx	d		;DE->S2
	inx	d		;point to sector count
	ldax	d		;get it
	add	l
	mov	l,a
	mov	a,h
	aci	0
	mov	h,a		;HL now has total sectors
	xthl			;do some fancy shuffling
	xchg
	xthl
	xchg
	mov	m,d
	inx	h
	mov	m,e
	pop	d		;all back to normal
	inx	h
	shld	optr		;save new pointer
	xchg
	lhld	numfls		;get file count
	inx	h		;increment
	shld	numfls		;save it
	lxi	h,13		;size of next entry
	dad	d
	xchg			;future optr in DE
	lhld	bdos+1		;pick up TPA end
	mov	a,e
	sub	l		;compare optr-tpa end
	mov	a,d
	sbb	h
	jnc	outmem		;if no memory left, error out
	ret
;
;
;	PCHAR - print character in A with Ctrl-C/S check
;
pchar:	push	b		;save all registers
	push	d		;  /
	push	h		; /
	push	psw		;/
;
	mvi	c,dircon	;poll console
	mvi	e,0ffh		; /
	call	bdos		;/
;
	cpi	'C'-40h 	;^C?
	jz	abort		;abort if so
	cpi	'S'-40h 	;^S?
	cz	pause		;pause if so
;
	pop	psw		;get A back
	ani	7fh		;strip high bit
	cpi	lf		;is it a line feed
	cz	lfproc		;process if so, else...
	mvi	c,dircon	;print it
	mov	e,a		; /
	call	bdos		;/
;
	pop	h		;restore other registers
	pop	d		; /
	pop	b		;/
	ret			;to caller
;
lfproc: lda	pgflg		;see if paging or not
	ora	a		;/
	mvi	a,lf		;just in case, put line feed in A
	rnz			;if no paging, simply return
;
	lda	row		;get row #
	dcr	a		;decrement
	sta	row		;save it again
	ora	a		;zero?
	jz	wait		;if so, wait until key pressed to continue
	mvi	a,lf
	ret			;...else return and print lf
;
wait:	lxi	d,wmsg		;point to <<< Any Key >>> message
	mvi	c,pstring	;BDOS print string
	call	bdos		;print it
;
wloop:	mvi	c,dircon	;poll console
	mvi	e,0ffh		; /
	call	bdos		;/
	ora	a		;zero returned?
	jz	wloop		;if so, loop until key typed; else...
	cpi	'C'-40h 	;^C?
	jz	abort		;abort if so
;
	lxi	d,wmclr 	;point to clear-line string
	mvi	c,pstring	;BDOS print string
	call	bdos		;print it
;
	lda	numcol		;reset column count
	sta	column		;/
	lda	numlin		;reset line count
	sta	row		;/
;
	mvi	a,cr		;print cr upon return
	ret
;
wmsg:	db	cr,lf,'[Any Key]$'
wmclr:	db	cr,20h,20h,20h,20h,20h,20h,20h,20h,20h,'$'
;
abort:	mvi	c,pstring	;bdos print string
	lxi	d,amsg		;abort message
	call	bdos		;print it
	jmp	quit		;...and end the program
;
amsg:	db	cr,lf,cr,lf,'+++ Aborted +++',cr,lf,'$'
;
pause:	mvi	c,dircon	;poll console
	mvi	e,0ffh		; /
	call	bdos		;/
	ora	a		;character typed?
	jz	pause		;if not, loop again
	cpi	'C'-40h 	;is the typed character a ^C?
	jz	abort		;if so, abort
	ret			;...else go home
;
;
;	PRINT - print string past call
;
print:	pop	h		;get RET address
print1: mov	a,m		;get a character
	ora	a		;null terminator?
	jz	prend		;done - back to program
	call	pchar		;print the character
	inx	h		;bump pointer
	jmp	print1		;get another
prend:	inx	h		;point past text
	pchl			;RET there
;
;
;	PRHL - print string at HL up to a null terminator
;
prhl:	mov	a,m		;get a character
	ora	a		;null terminator?
	rz			;return if so
	call	pchar		;else print it
	inx	h		;bump pointer
	jmp	prhl		;print another character
;
;
;	PFN - print filename pointed to by HL
;
pfn:	push	h		;save the pointer
	mvi	b,8		;# of characters to print
	call	pnum		;print the filename
	pop	h		;restore the pointer
	lxi	d,9		;offset to $SYS byte
	dad	d		;add it
	mov	a,m		;get the $SYS flag byte
	ani	80h		;returns zero if not $SYS
	mvi	a,'.'		;a period in A just in case
	jz	psep		;...file isn't $SYS
	mvi	a,'*'		;file has $SYS byte set, use asterisk
psep:	call	pchar		;print whatever file separator is used
	dcx	h		;point to the filetype
	mvi	b,3		;...# of characters to print,
	call	pnum		;...and print the filename
	ret
;
;
;	PNUM - print # of bytes in B of string pointed to by HL
;
pnum:	mov	a,m		;get character
	ani	7fh		;strip high bit
	call	pchar		;print it on console
pn1:	inx	h		;bump pointer
	dcr	b		;decrement counter
	rz			;return if counter zero
	jmp	pnum		;...else do it again
;
;	QFILL - fill default fcb with question-marks (*.*)
;
qfill:	lxi	h,dfcb+1	;point to default fcb filename
	mvi	b,11		;# of bytes to fill
qflop:	mvi	m,'?'		;move a question mark into the fcb
	inx	h		;increment pointer
	dcr	b		;decrement counter
	jnz	qflop		;if not done, then do again
	ret			;...else go home
;
;
;
;	This sort routine is adapted from software tools by Kernigan and
;	Plaugher.
;
sort:
;
;	Initialize the order table
;
	lhld	numfls		;get file name count
	push	h		;save it
;
	lhld	filebuf		;get start of name table
	xchg			;into DE
	lxi	h,order		;point to order table
	lxi	b,13		;entry length
;
bldord:	mov	m,e		;save low order address
	inx	h
	mov	m,d		;save high order address
	inx	h
	xchg			;table addr to DE
	dad	b		;point to next entry
	xchg
	xthl			;save tbl addr, fetch loop counter
	dcx	h		;count down loop
	mov	a,l
	ora	h		;more?
	xthl			;(restore tbl addr, save counter)
	jnz	bldord		;yes, go do another one
;
	pop	h		;clean loop counter off stack
	lhld	numfls		;get max # of entry pairs
	shld	count		;save for sort
	dcx	h		;subtract one to get max # of pairs
	mov	a,h		;zero?
	ora	l		;/
	rz			;if so, only one file.	No need to sort
;
	lhld	count		;# of entries
;
l0:	ora	a		;clear carry
	mov	a,h		;gap = gap/2
	rar
	mov	h,a
	mov	a,l
	rar
	mov	l,a
	ora	h		;is it zero?
	rz			;then none left
	mov	a,l		;make gap odd
	ori	1
	mov	l,a
	shld	gap
	inx	h		;i = gap+1
;
l2:	shld	i
	xchg
	lhld	gap
	mov	a,e		;j = i-gap
	sub	l
	mov	l,a
	mov	a,d
	sbb	h
	mov	h,a
;
l3:	shld	j
	xchg
	lhld	gap		;jg = j+gap
	dad	d
	shld	jg
	mvi	a,13		;compare 13 characters
	call	scomp		;compare (j) and (jg)
	jp	l5		;if a(j) <= a(jg)
	lhld	j
	xchg
	lhld	jg
	call	swap
	lhld	j
	xchg
	lhld	gap
	mov	a,e
	sub	l
	mov	l,a
	mov	a,d
	sbb	h
	mov	h,a
	jm	l5		;if j > 0 goto l3
	ora	l		;check for zero
	jz	l5
	jmp	l3
;
l5:	lhld	count		;for later
	xchg
	lhld	i		;i = i+1
	inx	h
	mov	a,e		;if i <= n goto l2
	sub	l
	mov	a,d
	sbb	h
	jp	l2
	lhld	gap
	jmp	l0
;
;	Swap entries in the order table
;
swap:	lxi	b,order-2	;table base
	dad	h		;*2
	dad	b		;plus base
	xchg
	dad	h		;*2
	dad	b		;plus base
	mov	c,m
	ldax	d
	xchg
	mov	m,c
	stax	d
	inx	h
	inx	d
	mov	c,m
	ldax	d
	xchg
	mov	m,c
	stax	d
	ret
;
;	Special compare for sort
;
scomp:	lxi	b,order-2
	dad	h
	dad	b
	xchg
	dad	h
	dad	b
	xchg
	mov	c,m
	inx	h
	mov	b,m
	xchg
	mov	e,m
	inx	h
	mov	d,m
	xchg
	mov	e,a		;count
;
cmplp:	mov	a,m
	ani	7fh
	mov	d,a
	ldax	b
	ani	7fh
	cmp	d
	inx	b
	inx	h
	rnz
	dcr	e
	jnz	cmplp
	ret
;
;	COMP - Compares two strings.
;
comp:	push	h		;save table addr
	mov	e,m		;load low order
	inx	h
	mov	d,m		;load high order
	inx	h
	mov	c,m
	inx	h
	mov	b,m
;
; BC, DE now point to entries to be compared
;
	xchg
	mov	e,a		;get count
;
cmplp1:	mov	a,m
	ani	7fh
	mov	d,a
	ldax	b
	ani	7fh
	cmp	d
	inx	h
	inx	b
	jnz	noteql		;quit on mismatch
	dcr	e		;or end of count
	jnz	cmplp1
;
noteql:	pop	h
	ret			;cond code tells all
;
;
;	MOVE - Moves the number of characters in BC from (HL) to (DE)
;
move:	mov	a,m		;get char from (HL)
	stax	d		;put in (DE)
	inx	h
	inx	d
	dcx	b
	mov	a,c		;get LS count byte
	ora	b		;both B & C zero?
	jnz	move		;loop til done
	ret
;
;	DOIT - Convert filesize at (HL) to K
;
doit:	mov	d,m
	inx	h
	mov	e,m		;size in DE (sectors)
;
	lda	cmpflg		;block-size compensation wanted?
	ora	a		;/
	jz	cmpsat		;yes, go ahead
;
	mvi	a,7		;put 1k block mask in A
	jmp	compk		;go compute K
;
cmpsat: lda	blkmsk
compk:	push	psw
	add	e
	mov	e,a
	mov	a,d
	aci	0
	mov	d,a
	pop	psw
	cma
	ana	e
	mov	e,a
	mvi	b,3
sder:	mov	a,d
	ora	a
	rar
	mov	d,a
	mov	a,e
	rar
	mov	e,a
	dcr	b
	jnz	sder
	ret
;
;	SHLL - shift HL left by B bits
;
shll:	dad	h
	dcr	b
	rz
	jmp	shll
;
;	DECPRT - print HL in decimal with leading zero suppression
;
decprt: xra	a		;clear leading zero flag
	sta	lzflg
	lxi	d,-10000	;print 10000's digit
	call	digit
	lxi	d,-1000 	;print 1000's digit
	call	digit
d3:	lxi	d,-100		;etc.
	call	digit
	lxi	d,-10
	call	digit
	mvi	a,'0'		;get 1's digit
	add	l
	jmp	pchar
;
digit:	mvi	b,'0'		;start off with ASCII "0"
;
diglp:	push	h		;save current remainder
	dad	d		;subtract
	jnc	digex		;quit on overflow
	pop	psw		;throw away remainder
	inr	b		;bump digit
	jmp	diglp		;loop back
;
digex:	pop	h		;restore pointer
	mov	a,b
	cpi	'0'		;zero digit?
	jnz	dignz		;no, type it
	lda	lzflg		;leading zero?
	ora	a
	mvi	a,'0'
	jnz	pchar		;print digit
	lda	supspc		;get space suppression flag
	ora	a		;see if printing file totals
	rz			;yes, don't give leading spaces
	mvi	a,20h		;leading zero...print space
	jmp	pchar
;
dignz:	sta	lzflg		;leading zero flag so next zero prints
	jmp	pchar		;...and print digit
;
;	SETSRC - Set DMA to default standard (base+80h)
;
setsrc: lxi	d,ddma
	mvi	c,setdma
	jmp	bdos
;
;	PDU - print current DU:
;
pdu:	mvi	c,getd		;get current disk
	call	bdos
	adi	'A'		;convert to ASCII
	call	pchar		;print it
	mvi	c,userst	;get current user
	mvi	e,0ffh
	call	bdos
	mov	l,a		;move result to HL for print
	mvi	h,0
	call	decprt		;print it
	mvi	a,':'		;the colon
	jmp	pchar		;print and go home
;
;	Compute sendtime from record count in HL.  Returns with:
;	BC = minutes, HL = seconds
;
filtim: push	h		;save record count
	lda	baud		;get baud rate indicator
	push	psw		;save it
	mvi	d,0
	lxi	h,btable	;point to baud factor table
	lda	kflg		;1k blocks?
	ora	a
	jz	ft1		;no, go ahead
	lxi	h,ktable	;else point to 1k baud factor table
ft1:	pop	psw		;get baud rate back
	mov	e,a		;set up for table access
	dad	d		;index to proper factor
	dad	d
	mov	e,m
	inx	h
	mov	d,m
	pop	h		;get # of records
	call	dvhlde		;divide HL by value in DE (records/min)
	push	h		;save remainder
	lda	baud		;get baud rate indicator
	push	psw		;save it
	lxi	h,rectbl	;point to divisors for seconds calc.
	lda	kflg		;1k blocks?
	ora	a
	jz	ft2		;nope
	lxi	h,krectbl	;yes, point to 1k divisor table
ft2:	pop	psw		;restore SPEED value
	mvi	d,0		;baud rate into DE
	mov	e,a		;/
	dad	d		;index into table
	mov	a,m		;get multiplier
	pop	h		;get remainder
	call	mulhla		;multiply HL by A
	call	shfthl
	call	shfthl
	call	shfthl
	call	shfthl
	mvi	h,0		;HL now = seconds (L=secs, H=0)
	ret			;end of FILTIM routine
;
;	Multiply the value in HL by the value in A.  Return with answer in HL
;
mulhla: xchg			;multiplicand to DE
	lxi	h,0		;init product
	inr	a
mulhlal: dcr	a
	rz
	dad	d
	jmp	mulhlal
;
;	Shift HL one bit to the right
;
shfthl: mov	a,l
	rar
	mov	l,a
	ora	a		;clear the carry bit
	mov	a,h
	rar
	mov	h,a
	rnc
	mvi	a,128
	ora	l
	mov	l,a
	ret
;
;	Divides HL by DE.  Upon exit:  BC=Quotient, HL=Remainder
;
dvhlde: push	d		;save divisor
	mov	a,e
	cma			;negate divisor
	mov	e,a
	mov	a,d
	cma
	mov	d,a
	inx	d		;DE is now two's complemented
	lxi	b,0		;init quotient
divl1:	dad	d		;subtract divisor from dividend
	inx	b		;bump quotient
	jc	divl1		;loop until sign changes
	dcx	b		;adjust quotient
	pop	d		;retrieve divisor
	dad	d		;readjust remainder
	ret
;
rectbl: db	192,74,51,38,32,20,11,8,5,3,0
btable: dw	5,13,19,25,30,48,87,141,210,280,0
krectbl:db	192,69,46,36,30,18,9,5,3,2,0
ktable: dw	5,14,21,27,42,54,103,190,330,525,0
sptbl:	db	'110',0,0,0,'300',0,0,0,'450',0,0,0,'600',0,0,0
	db	'710',0,0,0,'1200',0,0,'2400',0,0,'4800',0,0
	db	'9600',0,0,'19200',0
;
;	UDD - Unpacks (and displays) 3 decimal digits from binary value
;	      in HL with leading spaces
;
udd:	push	d
;
	lda	lzflg		;get leading zero flag
	mov	b,a		
	lda	supspc		;get suppress space flag
	mov	c,a
	push	b		;save them both
	xra	a
	sta	lzflg		;no leading zeros
	mvi	a,1
	sta	supspc		;space padded
	call	d3		;print digit
	pop	b		;get supspc and lzflag back
	mov	a,b
	sta	lzflg		;restore them
	mov	a,c
	sta	supspc
;
	pop	d
	ret
;
;	UDDZP - Unpacks and displays two-digit decimal number from
;		binary in A with leading 0
;
uddzp:	push	b		;save BC
	mvi	b,'0'-1 	;initialize quotient
uddzp1: inr	b		;increment quotient
	sui	10		;repeatedly subtract 10
	jnc	uddzp1		;loop until underflow
;
	adi	10+'0'		;correct underflow and make ASCII
	push	psw		;save it
	mov	a,b		;get quotient (tens place digit)
	call	pchar		;print it
	pop	psw		;get remainder (units place digit)
	pop	b		;restore old BC
	jmp	pchar		;print A and return
;
;	DOOPT - Handle command-line options
;
doopt:	push	h		;save option pointer
doopt1: inx	h		;point to option
	mov	a,m		;get character
	ora	a		;null?
	jz	optret		;return if so
	cpi	'S'		;request for $SYS files?
	jz	setsys		;take care of it if so
	cpi	'R'		;filesizes in records?
	jz	setrec
	cpi	'U'		;user-area change?
	jz	newusr
	cpi	'D'		;reset disk?
	jz	rstdsk
	cpi	'C'		;no block compensation?
	jz	nobcmp
	cpi	'V'		;show program name and version?
	jz	shover
	cpi	'N'		;no paging wanted?
	jz	nopage
	cpi	'K'		;filtimes calculated as for 1k packets?
	jz	setk
	cpi	'B'		;specify baud rate?
	jz	difbd
	cpi	20h		;space?
	jnz	opterr		;if not, must be bad option
;
optret: pop	h		;clear stack
	jmp	dodir		;do directory
;
setsys: lda	wheel		;get wheel value
	ora	a		;zero?
	jz	opterr		;error out if so
;
	mvi	a,0ffh		;set so $SYS files displayed
	sta	sysflg		;/
	jmp	doopt1		;check for another option
;
setrec: mvi	a,0ffh		;set so filesizes given in records
	sta	recflg		;/
	jmp	doopt1		;check for another option
;
rstdsk: lda	wheel		;get wheel value
	ora	a		;zero?
	jz	opterr		;error out if so
;
	push	h		;save pointer on stack
	mvi	c,resetd	;BDOS reset disk system
	call	bdos		;do it
	pop	h		;clear stack
	jmp	doopt1		;check for another option
;
nobcmp: mvi	a,0ffh		;set flag for no block compensation
	sta	cmpflg		;/
	jmp	doopt1
;
shover: lda	verflg		;version #'s shown already
	ora	a		;/
	jnz	doopt1		;don't print if so
	push	h		;save pointer
	call	print
	db	'S>imple S>orted D>irectory v'
	db	vers+'0','.',rev+'0'
	db	' (remote version) | '
	db	(month/10)+'0',(month mod 10)+'0','/'
	db	(day/10)+'0',(day mod 10)+'0','/'
	db	(year/10)+'0',(year mod 10)+'0'
	db	cr,lf,cr,lf,0
	pop	h		;restore pointer
	mvi	a,0ffh		;set version # shown flag so it doesn't
	sta	verflg		;...print again
	jmp	doopt1
;
nopage: mvi	a,0ffh		;set flag for no paging
	sta	pgflg		;/
	jmp	doopt1
;
newusr: inx	h		;first user-area digit
	inx	h		;second      "
	mov	a,m		;get it
	sui	'0'		;subtract ASCII offset
	cpi	10		;0-9?
	jnc	onenum		;no, maybe one digit
	mov	c,a		;else move to C for future ADD
	dcx	h		;point to ten's place digit
	mov	a,m		;get it
	sui	'0'		;subtract ASCII offset
	cpi	10		;0-9?
	jnc	usrerr		;no, must be bad #
	mov	b,a		;to be for ADD
	add	a		;multiply x2
	add	a		;x4
	add	a		;x8
	add	b		;x9
	add	b		;x10
	add	c		;add to one's place value
	inx	h		;point to last digit
	jmp	setusr		;select the specified user area
;
onenum: dcx	h		;come here if only one digit
	mov	a,m		;get digit
	sui	'0'		;subtract ASCII offset
	cpi	10		;0-9?
	jnc	usrerr		;if not, error out; else...
;
setusr: push	psw		;save requested user-area
	lda	maxusr		;get max user allowed from ZCPR
	mov	b,a		;for compare
	pop	psw		;get requested user back
	cmp	b		;compare to the max user area
	jnc	usrerr		;error out if illegal user
;
	push	h		;save pointer
	mvi	c,userst	;BDOS get/set user area
	mov	e,a		;for call
	call	bdos		;do it
	pop	h		;restore pointer
	jmp	doopt1		;check for another option
;
setk:	mvi	a,0ffh		;set kflg for filtim
	sta	kflg
	jmp	doopt1		;check for another option
;
difbd:	inx	h		;point to requested baud rate
	mov	a,m		;get it
	sui	'0'		;subtract ASCII offset
	cpi	10		;within legal range?
	jnc	bbaud		;if not, print error message and exit
	sta	baud		;else store it
	jmp	doopt1		;and return
;
bbaud:	call	print
	db	'Illegal baud-rate indicator specified.  Legal bps values are:'
	db	cr,lf,lf
	db	tab,'0 = 110  | 1 = 300  | 2 = 450  | 3 = 600  | 4 = 710'
	db	cr,lf
	db	tab,'5 = 1200 | 6 = 2400 | 7 = 4800 | 8 = 9600 | 9 = 19,200'
	db	cr,lf,0
	jmp	quit
;
opterr: inx	h		;point past bad option
	mvi	m,0		;terminate string with a null
	call	print
	db	'Illegal option -> ',0
	pop	h		;restore pointer to beginning of options
	call	prhl		;print up to bad apple
	call	print
	db	cr,lf,cr,lf,'Options available are:',cr,lf,cr,lf
	db	'Bn  - compute xfertimes for the Baudrate n (0-9)',cr,lf
	db	'C   - don''t Compensate for block-size in filesizes',cr,lf
	db	'K   - compute xfertimes as for 1K packet transfers',cr,lf
	db	'N   - No screen paging',cr,lf
	db	'R   - display file sizes in Records instead of k',cr,lf
	db	'Unn - change the default User area to nn',cr,lf
	db	'V   - show program''s name and Version number',cr,lf
	db	cr,lf,0
;
	lda	wheel		;get the user's status
	ora	a		;wheel guy?
	jz	quit		;if not, quit now
;
	call	print
	db	'The following options are available only when the WHEEL is '
	db	'set:',cr,lf,cr,lf
	db	'D   - reset the Disk drives before directory',cr,lf
	db	'S   - display files with the System flag set',cr,lf
	db	cr,lf,0
	jmp	quit		;exit to CP/M
;
;************************
;*** UNITIALIZED AREA ***
;************************
;
defd:	db	0		;storage for default disk
defu:	db	0		;storage for default user area
baud:	db	0		;storage for baud rate indicator
gap:	dw	0		;storage for SORT
i:	dw	0		;  /
j:	dw	0		; /
jg:	dw	0		;/
sysflg: db	0		;$SYS file display flag
recflg: db	0		;filesizes in records flag
cmpflg: db	0		;block-size compensation flag
verflg: db	0		;version #'s shown flag
pgflg:	db	0		;page output flag
kflg:	db	0		;1k packet flag
row:	db	0		;row counter
column: db	0		;column # pointer
optr:	dw	0		;file buffer and order table pointer
filebuf:dw	0		;markes beginning of filename buffer
numfls: dw	0		;# of files (extents)
blkshf: db	0		;disk block shift factor
blkmsk: db	0		;block mask
blkmax: dw	0		;max # of blocks on disk
dirmax: dw	0		;max # of directory entries on disk
freeby: dw	0		;free space left on disk
totfil: dw	0		;total # of files on disk
totsiz: dw	0		;total amount of space taken up by files
totrec: dw	0		;same as totsiz except records
dirspc: db	0		;amount of space (in K) taken up by dir tracks
totfre: dw	0		;total space available on disk
count:	dw	0		;file count used by display routine
lzflg:	dw	0		;leading zero flag, used by decprt:
supspc: dw	0		;suppress zeading spaces flag, decprt: again
datend	equ	$		;marks end of data/flags
;
oldsp:	dw	0		;storage space for old stack pointer
	ds	64		;32 level stack
stack	equ	$
;
	db	0
order	equ	$		;beginning of order table
;
	end