;--------------------------------------------------------------------------
; SSTAT.ASM - a SuperSTAT program.
;
; Copyright (C) by David Jewett, III, 1986.  All rights reserved. You shall
; not use this program for commercial purposes or for monetary gain without
; first obtaining written permission from the author.
;
; Your comments and bug reports are welcome:
;
;			David Jewett, III
;			10376 Iron Mill Road
;			Richmond, VA  23235
;			Day Phone:  (804) 794-7667
;
; or upload them to Data-Plus(tm) (914) 246-6906 and/or leave a message.
;
; Thanks to Harry Kaemmerer for his help with this program.
;
; Version 1.0 - 1/25/86
;
; -------------------------------------------------------------------------
; Revisions in reverse order:
; ver. 1.8 02/21/86 Inserted one more ANI 7FH in the TYPE routine.  Many
;		    terminals (e.g. newer Kaypros) use a set high bit as
;		    a signal to change character sets or go to a graphics
;		    mode.  One line added, marked with `b/m'.
;		    - Bruce Morgen
;
; ver. 1.7 02/18/86 Fixed bad instuction in MAKPTR routine.  Added YES/NO
;		    equates - D. Jewett, III
;
; ver. 1.6 02/13/86 Changed "name line" routines for speedier output.
;		    Eliminated file space display at startup.
;		    - D. Jewett, III
;
; ver. 1.5 02/06/86 Now program knows if you change an attribute back to
;		    its original state so no change is needed to the
;		    directory. Also, attribute strings for R/O, SYS, and
;		    ARC reflect the directory status, not the tagged
;		    status.  And, added command to turn auto advance on/off
;		    as desired - D. Jewett, III
;
; ver. 1.4 02/01/86 Changed toggle routine to auto advance to next file
;		    after tagging and still re-display the change first.
;		    - Harry Kaemmerer
;
; ver. 1.3 01/31/86 Fixed problem with sort where attributes were affecting
;		    the sorting order - D. Jewett, III
;
; ver. 1.2 01/29/86 Various cosmetic changes - D. Jewett, III
;
; ver. 1.1 01/25/86 Added additionals to command table .. you now can use
;		    the original and WS commands interchangably at will.
;		    The command table is nolonger part of the help display.
;		    Added message that end of BIOS can't be detected by
;		    this PGM as this changes with every system and there
;		    are no rules for CP/M to indicate end of BIOS.
;		    - Harry Kaemmerer
;
; -------------------------------------------------------------------------
;			      Index to modules
;			      ----------------
;
;	 ID		     Function
;	-----	---------------------------------------
;	 {0}  = Main Program and User Customizable data
;	 {2}  = File Name Processing
;	 {3}  = Disk I/O
;	 {4}  = Array Processing
;	 {5}  = System Information
;	 {6}  = Arithmetic/Logic Subroutines
;	 {7}  = Console I/O
;	 {8}  = Utility Subroutines
;	 {9}  = Initialized Data
;
; -------------------------------------------------------------------------
;				   Equates
;				   -------
;
YES	EQU	0FFH		;byte-sized logical true
NO	EQU	0		;byte-sized logical false
;
VTENS	EQU	'1'		;version number tens
VUNITS	EQU	'7'		;version number units
;
; CP/M functions
;
CONIN	EQU	1		;get console input
CONOUT	EQU	2		;console output
DCONIO	EQU	6		;direct console input/output
GETIOB	EQU	7		;get iobyte
CONSTAT	EQU	11		;get console status
RSTDSK	EQU	13		;reset disk system
SELDSK	EQU	14		;select disk
SRCHFST	EQU	17		;search for first directory occurrence
SRCHNXT	EQU	18		;search for next directory occurrence
GETDSK	EQU	25		;get current disk number
SETDMA	EQU	26		;set DMA address
GETALV	EQU	27		;get allocation vector address
SETATT	EQU	30		;set file attributes
GETDPB	EQU	31		;get disk parameter block address
SETUSR	EQU	32		;2.x set user number
GETUSR	EQU	SETUSR		;2.x get current user number
;
; Addresses
;
SBASE	EQU	0000H		;system base address
WBOOT	EQU	SBASE		;warm start
BDOS	EQU	SBASE+0005H	;bdos entry address
CMDBUF	EQU	SBASE+0080H	;cp/m's default DMA/command buffer
TPA	EQU	SBASE+0100H	;where this program lives
;
; ASCII values
;
BELL	EQU	7		;ring console bell
BS	EQU	8		;back space
TAB	EQU	9		;horizontal tab
LF	EQU	10		;line feed
CR	EQU	13		;carriage return
ESC	EQU	27		;escape
SPACE	EQU	' '		;blank
DEL	EQU	127		;rubout
;
; FCB definitions
;
FCBSZ	EQU	32		;size of entire fcb (without cr,r0,r1,r2)
FNAMSZ	EQU	11		;size of file name in fcb (name + type)
FTYPSZ	EQU	3		;size of file "type" field in file name
EXTOFF	EQU	12		;offset to extent byte in fcb
RCOFF	EQU	15		;offset to Record Count byte in fcb
;
; Miscellaneous equates
;
FATTS	EQU	11		;offset in our file names to attribute word
NTRYSZ	EQU	15		;size of a file name entry in our table
;
;==========================================================================
; {0}		      Start of code - MAIN module
;		      ---------------------------
;
	ORG	TPA		;code starts at transient program area.
	JMP	START		;jump to real start of program
;
;==========================================================================
; User customizable data
;
ATTON:	DB	0,0,0,0		;string to turn video attribute ON
	DB	0		;string terminator
ATTOFF:	DB	0,0,0,0		;string to turn video attribute OFF
	DB	0		;string terminator
MAXDRV:	DB	'P'		;max. accessible drive (CHARACTER)
MAXUSR:	DB	15		;max. accessible user (0..15 only)
MAXNARG:DW	512		;max. no. of directory EXTENTS to load
ADVANC:	DB	YES		;YES = do auto advance, NO = do not
;
; -------------------------------------------------------------------------
; Command Table.  Each entry consists of a command character followed by
; a vector address.  Command STRINGS are NOT supported.  Thus the "arrow"
; keys on many computers will not work.
;
CMDTBL:	DB	'B'-64		;control-X = cursor down
	DW	FORWRD
	DB	'A'-64		;control-E = cursor up
	DW	BACK
	DB	'D'-64		;control-S = cursor left
	DW	LEFT
	DB	'C'-64		;control-D = cursor right
	DW	RIGHT
	DB	'A'-64		;set file attributes
	DW	SFA
	DB	'T'-64		;toggle attribute
	DW	TOGGLE
	DB	CR		;move forward one file
	DW	FORWRD
	DB	'B'		;move back one file
	DW	BACK
	DB	BS		;move cursor left
	DW	LEFT
	DB	SPACE		;move cursor right
	DW	RIGHT
	DB	'T'		;toggle attribute
	DW	TOGGLE
	DB	'A'		;set file attributes
	DW	SFA
	DB	'F'		;find a file
	DW	FIND
	DB	'I'		;print disk Information
	DW	PSTAT
	DB	'L'		;log new DU:
	DW	LOGON
	DB	'N'		;Next line auto advance on/off
	DW	AUTAD
	DB	'S'		;print free Space
	DW	PFREE
	DB	'X'		;quit
	DW	DONE
	DB	'?'		;print help menu
	DW	MENU
	DB	'C'-64		;quit and warm boot
	DW	SBASE
	DB	0		;zero marks the end of the table
;
;==========================================================================
; Main line code
;
; Set up stack and save drive and user at startup
;
START:	LXI	H,0		;save old stack pointer
	DAD	SP
	SHLD	OLDSP
	LXI	SP,STACK	;set local stack
	CALL	GETDU		;save drive and user at startup
	LDA	DRIVE
	STA	LOGDRV
	LDA	USER
	STA	LOGUSR
	CALL	ILPRT		;print a help message
	DB	CR,LF,' SSTAT ver. ',VTENS,'.',VUNITS
	DB	' use "?" for help.',CR,LF,0
;
; Get argument, if any, from the command line
;
	LXI	H,CMDBUF	;point to command buffer
	MOV	A,M		;get character count
	ORA	A		;any argument?
	JZ	NOARG		;NO - then we're done here
BLANKS:	INX	H		;point to next character in command line
	MOV	A,M		;get a character from the line
	CPI	SPACE		;a space?
	JZ	BLANKS		;YES - look until we get to the real stuff
	JC	NOARG		;else no argument if we hit end of line
	LXI	D,ARGBUF	;else point to our local buffer
GETARG:	STAX	D		;move a character to our buffer
	INX	H		;bump pointers
	INX	D
	MOV	A,M		;get next char. from command line
	CPI	SPACE+1		;end of line?
	JNC	GETARG		;NO - then get more
	XRA	A		;else terminate our buffer with a zero
	STAX	D
;
; Process a file name entered in the command line
;
	LXI	H,ARGBUF	;point to our copy of the command
	PUSH	H		;and save that address
	MOV	A,M		;get a character
	CPI	'?'		;is it a '?'
	JNZ	GOTFN		;NO - then move on
	INX	H		;point to next character
	MOV	A,M		;get it
	CPI	0		;is it a zero (end of string) ?
GOTFN:	POP	H		;in any event, restore arg's address
	JNZ	LOADIR		;not '?' so start the program
	CALL	ILPRT		;else print a help message
	DB	CR,LF,'Usage: SSTAT [<du:><filename>]',CR,LF,0
	JMP	DONEX		;and quit now
;
; User did not specify a file name, so make FCB all wild, current DU:
;
ALLWLD:	DB	'*.*',0		;a totally wild file name
NOARG:	LXI	H,ALLWLD	;point to wild file name
;
; Log onto a drive/user and get all matching extents
;
LOADIR:	CALL	LOG		;log onto the disk
	JC	LOGON		;if error, ask user to log new drive
;
	LXI	H,0		;initialize index to first name
	SHLD	FNDX
	MVI	A,8		;initialize attribute
	STA	ATT
	CALL	RING		;set up the name "ring"
;
OBEY0:	CALL	NEWLINE		;next console line
OBEY1:	CALL	NAMOUT		;print the "name line"
OBEY2:	CALL	GETCHAR		;get a character
	MOV	B,A		;and put it in B
	LXI	H,CMDTBL	;point to the command table
OBYLUP:	MOV	A,M		;get a command from table
	INX	H		;and increment pointer to address
	ORA	A		;test "command" for zero
	JZ	OBEY2		;if zero, end of table, so loop
	CMP	B		;else compare with character
	JZ	DSPATCH		;if MATCH then DISPATCH
	INX	H		;else increment pointer over
	INX	H		;the address
	JMP	OBYLUP		;and try another entry from the table
DSPATCH:
	MOV	A,M		;load low byte of the vector address
	INX	H		;point to high byte
	MOV	H,M		;get the high byte
	MOV	L,A		;HL now contains entire vector
	PCHL			;so go to it
;
; move cursor right
;
RIGHT:	LHLD	CPTR		;get the character pointer
	MOV	A,M		;retrieve the character it points to
	CALL	TYPE		;type it to move cursor over
	INX	H		;point to next character
	LDA	ATT		;get attribute
	INR	A		;bump it
	CPI	8		;is it the first "type" character?
	JNZ	RIGHT1		;NO - then move on
	PUSH	PSW		;else we must type the period
	MVI	A,'.'
	CALL	TYPE
	POP	PSW
RIGHT1:	CPI	11		;are we at the end of the name?
	JNZ	RIGHT9		;NO - then boogie
	INR	A		;else adjust ATT and cptr so
	INX	H		;we can
RIGHT2:	CALL	BAKSPC		;back-space to beginning of name
	DCX	H		;(12 times total)
	DCR	A
	JNZ	RIGHT2
RIGHT9:	SHLD	CPTR		;save new character pointer
	STA	ATT		;and save new attribute index
	JMP	OBEY2		;and go get next command
;
; move the cursor left
;
LEFT:	LHLD	CPTR		;get the character pointer
	LDA	ATT		;and the attribute index
	ORA	A		;attribute = 0?
	JNZ	LEFT3		;NO - then we don't need to:
LEFT1:	PUSH	PSW		;print the entire file name
	MOV	A,M
	CALL	TYPE
	POP	PSW
	CPI	7		;if at the 7th char., print period
	JNZ	LEFT2
	PUSH	PSW
	MVI	A,'.'
	CALL	TYPE
	POP	PSW
LEFT2:	INX	H
	INR	A
	CPI	11		;do all 11 characters of the name
	JNZ	LEFT1
LEFT3:	DCR	A		;adjust ATT back one
	DCX	H		;similarly for character pointer
	CALL	BAKSPC		;type a backspace
	CPI	7		;are we at the 7th char.?
	JNZ	LEFT9		;NO - then we don't need to:
	CALL	BAKSPC		;type an extra BS to move over the period
LEFT9:	STA	ATT		;save resultant ATT
	SHLD	CPTR		;and character pointer
	JMP	OBEY2		;go get next command
;
; move back one file
;
BACK:	LHLD	FNDX		;get file index
	MOV	A,L		;and test for zero
	ORA	H
	JNZ	BACK1		;move on if NOT zero
	LHLD	NARGC		;else use MAX file count
	CALL	NEWLINE		;and issue an extra cr/lf
BACK1:	DCX	H		;file index -= 1
	SHLD	FNDX		;save new file number
	JMP	OBEY0		;print name line & get next command
;
; move forward one file
;
FORWRD:	LHLD	FNDX		;get file index
	INX	H		;bump it
	XCHG			;save it in DE
	LHLD	NARGC		;get MAX file count
	CALL	COMPARE		;compare (index - MAX)
	XCHG			;and put index back in HL
	JC	FORWR1		;if (index < MAX) then move on
	LXI	H,0		;else new index will be first file
	CALL	NEWLINE		;and issue an extra cr/lf
FORWR1:	SHLD	FNDX		;save new file index
	JMP	OBEY0		;print name line & get next command
;
; toggle file attribute
;
TOGGLE:	LHLD	CPTR		;get character pointer
	MOV	A,M		;get a character from the file name
	RAL			;roll 8th bit into carry
	CMC			;and complement the carry
	RAR			;then put the 8th bit back
	MOV	M,A		;and save the result
	LDA	ADVANC		;get auto advance flag
	ORA	A		;test - is it on ?
	JZ	OBEY1		;NO - then back to command loop
	CALL	NAMOUT		;else update the current "name line"
	JMP	FORWRD		;then go display next line
;
; turn auto-advance on/off
;
AUTAD:	LDA	ADVANC		;get auto advance flag
	CMA			;flip it
	STA	ADVANC		;put it back
	JMP	OBEY2		;get next command
;
; find a file
;
FIND:	CALL	ASK		;ask user for file spec
	JZ	OBEY0		;ignore if nothing was entered
	LXI	D,MYFCB		;convert the string to FCB format
	CALL	MAKEFCB
	LXI	H,FNAMSZ+1	;get offset to end of file name
	DAD	D		;add base address
FIND1:	DCX	H		;move pointer back in file name
	MOV	A,M		;get the character there
	CPI	SPACE		;is it a space?
	JNZ	FIND2		;NO - then break
	MVI	M,0		;else replace it with zero
	JMP	FIND1		;and continue to look for end of name
FIND2:	LXI	H,FCOMP		;install address of find-compare routine
	SHLD	MYCOMP		;into generic compare routine
	LXI	H,MYFCB+1	;get pointer to key to search for
	CALL	ISRCH		;search for match
	JZ	OBEY0		;oops, no match
	SHLD	FNDX		;else store index of matching entry
	JMP	OBEY0		;and then back to main loop
;
; Set File Attributes
;
SFA:	CALL	NEWLINE		;move to next console line
	LHLD	NARGC		;get count of files
	XCHG			;into DE
	LXI	H,0		;get index to first name
SFA1:	CALL	NEWATT		;set attributes as needed
	INX	H		;bump to next file
	CALL	COMPARE		;compare (count - index)
	JNZ	SFA1		;repeat for all files
	CALL	NEWLINE		;finish up the last line
	JMP	OBEY0		;re-print old line and get next command
;
; log a new drive/user
;
LOGON:	CALL	ASK		;get file spec from user
	JNZ	LOADIR		;if something was entered go log new DU:
	LHLD	NARGC		;else get file count
	MOV	A,H		;test for zero
	ORA	L
	JZ	LOGON		;if no files, repeat the question
	JMP	OBEY0		;else "never mind"
;
; ask user to enter a file spec
;
ASK:	CALL	ILPRT		;issue prompt
	DB	CR,LF,LF,'Enter filespec:  ',0
	LXI	H,ARGBUF	;get address of console buffer
	MVI	A,40		;and max. length of input (arbitrary)
	CALL	GETS		;get a string
	ORA	A		;test length
	RET			;and return
;
; Exit point
;
DONE:	MVI	C,CONSTAT	;clean up console queue
	CALL	BDOS
	ORA	A
	JZ	DONE1
	MVI	C,CONIN
	CALL	BDOS
DONE1:	LDA	LOGDRV		;log back to original DU:
	MOV	B,A
	LDA	LOGUSR
	MOV	C,A
	CALL	SETDU
DONEX:	LHLD	OLDSP		;restore original stack
	SPHL
	RET			;go back to CP/M
;
;==========================================================================
;			    Subroutines
;==========================================================================
; {2}			  File name module
;			  ----------------
; This module validates file names, extracts disk/user numbers, expands
; wild card characters, and installs names into file control blocks.
; -------------------------------------------------------------------------
; Expand a possibly ambiguous file name and fill buffer with all matches
; from the specified drive and user area.
;
; Entry:  HL = pointer to UPPER CASE file name
;	  DE = pointer to fcb that will receive file name (fcb[0-1] = user)
;
; Return:  NARGC = number of matches found
;	   NARGBUF contains names in fixed length fields
;	   DE preserved, other registers destroyed
;	   CARRY SET if file name error or no match found
;
DOWILD:	PUSH	H		;save pointer
	LXI	H,0		;so we can initialize NARGC: to zero
	SHLD	NARGC
	POP	H
	CALL	EXPAND		;expand the name into the fcb
	RC			;quit if name error
;
	CALL	DIRSRCH		;search directory for all matches
	RNC			;return now if match found
	CALL	ERRET		;else error
	DB	'no file ',0
;
; -------------------------------------------------------------------------
; Expand a possibly ambiguous file name into an fcb.
;
; Entry:  HL = pointer to UPPER CASE file name
;	  DE = pointer to fcb (fcb[0-1] = user)
;
; Return:  if successful, carry clear and HL = file name without du:
;	   if error, carry set and HL = complete file name
;	   BC and PSW destroyed
;	   CARRY SET if error
;
EXPAND:
	CALL	STRIPDU		;strip off the disk/user spec
	JNC	EXPND1		;continue if du: is ok
	CALL	ERRET		;ERROR - print message and return
	DB	'bad drive/user spec in ',0
;
EXPND1:	MOV	A,M		;get next character
	CPI	SPACE+1		;delimiter?
	JC	WILDFN		;YES - then make the name wild and return
	CALL	MAKEFCB		;else make an fcb for the file name
	RNC			;return if file name is ok
	CALL	ERRET		;ERROR - print msg. and ret
	DB	'invalid characters in ',0
;
; -------------------------------------------------------------------------
; "Strip" the disk/user spec off a file name and put it in fcb.
;
; Entry:  HL = pointer to UPPER CASE file name
;	  DE = pointer to fcb (fcb[0-1] = user)
;	  DRIVE = current drive
;	  USER	= current user
;
; Return: HL = pointer to next byte after DU: spec or unaffected
;	       if no DU: spec found
;	  DE unaffected
;	  BC and PSW destroyed
;	  CARRY SET if error
;
STRIPDU:
	PUSH	D		;save fcb address
	LDA	DRIVE		;put current du: in BC
	MOV	B,A
	LDA	USER
	MOV	C,A
;
COLON:	MVI	A,':'		;load a colon
	CALL	POS		;find position of it (if any) in name
	JZ	STRPDUN		;if no colon appears use default du:
;
	PUSH	H		;put original pointer to name on stack
	DCR	A		;test to see if ':' is first character
	JZ	BADDU		;bad du: if so
	LDA	MAXDRV		;get MAXDRV in Acc.
	CMP	M		;if drive > MAXDRV
	JC	BADDU		;then error
	MOV	A,M		;get the drive character in Acc.
	SUI	'A'		;is it less than 'A' ?
	JC	STRUSR		;then it's not a drive - try user
	MOV	B,A		;else get drive in B
	INX	H		;point to next character
;
STRUSR:	CALL	GETASCD		;get a digit and convert to binary
	JC	STRUSR1		;we're done here if not a good digit
	MOV	C,A		;else save a copy of the first number
	INX	H		;point to second (possible) digit
	CALL	GETASCD		;and try to get another digit
	JC	STRUSR1		;move on if no second digit
	MOV	D,A		;else save it
	INX	H		;point to whatever is next
	MOV	A,C		;get the 10's digit back
	RLC			;multiply times 2
	MOV	C,A		;save this
	RLC			;times 4
	RLC			;times 8
	ADD	C		;C * 10 =  C * 2 + C * 8
	ADD	D		;plus units
	MOV	C,A		;put new user code into C
STRUSR1:
	MOV	A,M		;get a character
	CPI	':'		;if it is not a colon then
	JNZ	BADDU		;we have a bad user spec
	INX	H		;else point to rest of file name
	LDA	MAXUSR		;get MAXUSR
	CMP	C		;compare with our user spec
	JC	BADDU		;error if user > MAXUSR
	POP	D		;discard original pointer to name
;
STRPDUN:
	POP	D		;restore fcb pointer
	DCX	D		;set to fcb[0-1]
	MOV	A,C		;get user number in Acc.
	STAX	D		;and store it
	INX	D		;point to fcb[0]
	MOV	A,B		;get drive code in Acc.
	INR	A		;increment since in fcb, A=1, B=2, etc.
	STAX	D		;store it
	XRA	A		;clear Acc./carry
	RET			;done
;
BADDU:	POP	H		;restore original name pointer
	POP	D		;and fcb address
	STC			;set carry = ERROR
	RET			;and return
;
; -------------------------------------------------------------------------
; Make an fcb from a file name.
;
; Entry:  HL = pointer to file name WITHOUT DRIVE/USER SPEC
;	  DE = pointer to fcb
;
; Return: HL and DE unaffected
;	  BC and PSW destroyed
;	  CARRY SET if BAD file name.
;
MAKEFCB:
	CALL	CLRFCB		;clear the fcb
	PUSH	H		;keep a copy of the file name pointer
	PUSH	D		;and a copy of the fcb pointer
	INX	D		;set pointer to the name field
	MVI	B,FNAMSZ-FTYPSZ	;character count for name, less type
MKNAME:	MOV	A,M		;get character from file name
	CALL	CHKCHR		;check it for validity
	JNZ	BADNAME		;break if bad character
	MOV	A,M		;get it back again
	INX	H		;point to next
	CPI	'.'		;if '.'
	JZ	MKTYPE		;then go do file type field
	CPI	'*'		;if '*'
	JZ	MKWILD		;then make wild
	CPI	SPACE+1		;if delimiter
	JC	MKDUN		;then all done
	STAX	D		;else put the character into the fcb
	INX	D		;point to next fcb character
	DCR	B		;decrement count
	JNZ	MKNAME		;do more until end of file name field
MKNAM1:	MOV	A,M		;we did all allowable name characters
	INX	H		;are there any more ?
	CPI	'.'		;must have type now
	JZ	MKTYP1		;so keep looking until we find '.'
	CPI	SPACE+1		;or if we find a delimiter
	JC	MKDUN		;then done
	JMP	MKNAM1		;extra name chars are ignored
;
MKWILD:	MVI	A,'?'		;fill rest of name field with '?'
MKWLD1:	STAX	D
	INX	D
	DCR	B
	JNZ	MKWLD1
	JMP	MKNAM1		;and find type field
;
MKTYPE:	INX	D		;increment DE to file type field
	DCR	B
	JNZ	MKTYPE
MKTYP1:	MVI	B,FTYPSZ	;get type field size in counter
MKTYP2:	MOV	A,M		;get character from file type
	CALL	CHKCHR		;check it for validity
	JNZ	BADNAME		;break if bad character
	MOV	A,M		;get character again
	INX	H		;point to next
	CPI	'.'		;if '.'
	JZ	BADNAME		;then break - '.' can't occur in type
	CPI	'*'		;if '*'
	JZ	MKWLD2		;then make wild
	CPI	SPACE+1		;if delimiter
	JC	MKDUN		;done
	STAX	D		;else put the character into the fcb
	INX	D		;point to next fcb character
	DCR	B		;decrement count
	JNZ	MKTYP2		;do more until end of file name field
;
MKDUN:	POP	D		;get original fcb address back
	POP	H		;restore original file name pointer
	XRA	A		;make sure flags reflect GOOD NAME
	RET			;and return
;
MKWLD2:	MVI	A,'?'		;make file type wild
	STAX	D
	INX	D
	DCR	B
	JNZ	MKWLD2
	JMP	MKDUN		;and we're done
;
BADNAME:
	POP	D		;restore original fcb address
	POP	H		;restore pointer to file name
	STC			;set error flag
	RET			;quit
;
; ------------------------------------------------------------------------
; Clear an fcb (exclusive of the user and drive bytes).
;
; Entry:  DE = fcb address
;
; Return:  FCB name and type filled with spaces.  Rest of fcb set to zero.
;	   all but PSW are unaffected.
;
CLRFCB:	PUSH	B		;save caller's reg.
	PUSH	D		;save fcb address
	INX	D		;and point to name field
	MVI	B,FNAMSZ	;get size of file name
	MVI	A,SPACE		;get a space character in Acc.
	CALL	PAD		;and pad file name with spaces
	POP	D		;restore old fcb
	CALL	ZEROFCB		;initialize rest of fcb
	POP	B		;restore old B reg.
	RET
;
; -------------------------------------------------------------------------
; "Zero" an fcb for access by setting all bytes after file name/type to 0.
;
; Entry DE = fcb address
;
; Return:  The business-end of the fcb is set to all zeros.
;	   all but PSW are unaffected
;
ZEROFCB:
	PUSH	B		;save all
	PUSH	D
	PUSH	H
	LXI	H,EXTOFF	;get offset to extent byte
	DAD	D		;added to address of fcb
	XCHG			;in DE reg.
	XRA	A		;clear Acc.
	MVI	B,FCBSZ-EXTOFF	;get size fcb less name & drive
	CALL	PAD		;and pad with zeros
	POP	H		;restore all
	POP	D
	POP	B
	RET			;and done
;
; -------------------------------------------------------------------------
; Set file name and type wild.
;
; Entry:  DE = fcb address
;
; Return: only PSW is affected
;
WILDFN:	PUSH	D		;save old regs
	PUSH	B
	CALL	CLRFCB		;clear the fcb
	INX	D		;point to file name field
	MVI	B,FNAMSZ	;get size of file name and type
	MVI	A,'?'		;get a question mark
	CALL	PAD		;fill the fcb name with '?'
	POP	B		;restore
	POP	D
	RET			;all done
;
; -------------------------------------------------------------------------
; Set extent, s1 and s2 (overflow extent) wild in an fcb.
;
; Entry:  DE = fcb address
;
; Return:  only PSW is affected
;
WILDEXT:
	PUSH	H		;save caller's HL
	LXI	H,EXTOFF	;get offset to extent in HL
	DAD	D		;add fcb base address
	MVI	A,'?'		;get a "wild" character
	MOV	M,A		;set extent wild
	INX	H		;and set s1 wild
	MOV	M,A
	INX	H
	MOV	M,A		;and set s2 wild
	POP	H		;restore
	RET			;and done
;
; -------------------------------------------------------------------------
; Check to see if a character is a legal file name componet.
;
; Entry:  Acc. = character to check
;
; Return:  ZERO SET if character is OK
;	   or Acc. contains relative position of invalid character
;
CHKCHR:	PUSH	H		;save caller's HL
	LXI	H,ILLTBL	;and use it to reference "illegal table"
	CALL	POS		;see if there is a match in table
	POP	H		;restore old
	RET			;and done
;
ILLTBL:	DB	',;:=''"',0
;
; -------------------------------------------------------------------------
; Print a file name.
;
; Entry:  HL = pointer to fcb image of filename
;
; Return: Nothing.  DE preserved.  Other regs. affected.
;
PRNFN:	MVI	A,FNAMSZ-1	;load INDEX to last character of name
;
; -------------------------------------------------------------------------
; Print up to the Nth character of a file name
;
; Entry:  HL = pointer to fcb image of filename
;	  Acc. = index to Nth character (0 .. n)
;
; Return: Nothing.  DE preserved.  Other regs. affected
;
PRNFNA:	MOV	C,A		;move index to C
	INR	C		;increment index to make COUNT (1 .. n+1)
	MVI	B,FNAMSZ	;load count of all characters in file name
PRNF1:	MOV	A,M		;get a character from file name
	INX	H		;point to next
	CALL	TYPE		;print one char. on console
	DCR	B		;decrement "done" count
	MVI	A,FTYPSZ	;are we at the "type" field?
	CMP	B
	JNZ	PRNF2		;NO - then don't need to:
	MVI	A,'.'		;print the period
	CALL	TYPE		;between the name and type
PRNF2:	DCR	C		;decrement "to do" count
	RZ			;return if all done
	JMP	PRNF1		;else loop
;
; -------------------------------------------------------------------------
; Print drive/user.
;
; Entry:  B = drive number (0 .. 15)
;	  C = user number  (0 .. 15, 32-user environments not supported)
;
; Return: all registers except PSW are preserved.
;
PRNDU:
	MOV	A,B		;get drive in Acc.
	ADI	'A'		;add character offset so 0 = 'A'
	CALL	TYPE		;type it
	MOV	A,C		;get user in Acc.
	CPI	10		;is user < 10?
	JC	PRNDU1		;if so, skip
	SUI	10		;else, subtract 10 to find units
	PUSH	PSW		;and save this
	MVI	A,'1'		;first digit will always be '1'
	CALL	TYPE		;so print that
	POP	PSW		;restore units value
PRNDU1:	ADI	'0'		;add ascii offset
	CALL	TYPE		;and type it
	MVI	A,':'		;get a colon
	CALL	TYPE		;type that
	RET			;all done
;
;--------------------------------------------------------------------------
; Set up the file name ring.
;
; Entry:  none
;
; Return:  Nothing, all regs affected
;
;	   Each entry in our file name list will have the following format:
;
;	      bytes --> 0  1  2  3  4  5  6  7	8  9 10 11 12 13 14
;			-------------------------------------------
;	   contains --> F  I  L  E  N  A  M  E	T  Y  P al ah rl rh
;
;	   where al/ah is a 16-bit image of the file attributes
;	   and	 rl/rh is a 16-bit record count for the file
;
;.....
;
; First, make the pointer array
;
RING:	LHLD	NARGC		;get number of extents
	MOV	B,H		;into BC
	MOV	C,L
	LXI	H,NARGBUF	;get pointer to first entry
	XCHG			;into DE
	LHLD	IOBUF		;get address of free memory in HL
	SHLD	NARGV		;save this as pointer to our pointer array
MAKPTR:	MOV	M,E		;put one pointer into array
	INX	H
	MOV	M,D
	INX	H
	PUSH	H		;save array address
	LXI	H,NTRYSZ	;get size of an entry in HL
	DAD	D		;add that to last
	XCHG			;with result in DE
	POP	H		;retrieve array address
	DCX	B		;decrement count
	MOV	A,B		;test for zero
	ORA	C
	JNZ	MAKPTR		;repeat until a pointer is made for all
	INX	H		;make room for extra pointer used by
	INX	H		;linear search routine
	SHLD	IOBUF		;save new address of I/O buffer
;
; then, sort the file names
;
	LHLD	NARGC		;get number of entries into HL
	SHLD	ASIZE		;initialize ASIZE for sort
	LHLD	NARGV		;get base address of NARG pointer array
	SHLD	ABASE		;initialize ABASE for sort
	LXI	H,XCOMP		;get address of compare routine
	SHLD	MYCOMP		;initialize MYCOMP for sort
	CALL	SSORT		;ready to sort the array
;
; eliminate duplicate extents (all but last)
;
	LHLD	NARGC		;get number of entries
	MOV	B,H		;into BC
	MOV	C,L
	LXI	H,STRNCMP	;get address of compare function
	SHLD	MYCOMP		;poke this into place
	LXI	D,0		;init. index (i) to first entry
CULL1:	DCX	B		;count - 1
	MOV	A,B		;test for zero
	ORA	C
	JZ	CULL9		;break when all compares have been done
	MOV	H,D		;HL = (i)
	MOV	L,E
	INX	D		;DE = (i + 1) = (j)
	PUSH	B		;save count
	MVI	B,FNAMSZ	;B = size of the file name
	CALL	SSCOMP		;compare the two file names
	JNZ	CULL2		;move on if the names are different
	CALL	IDEL		;else delete the first matching entry
	DCX	D		;adjust index for retest
CULL2:	POP	B		;restore the file name count
	JMP	CULL1		;loop until all names (extents) are done
;
CULL9:	LHLD	ASIZE		;get new size of the list
	SHLD	NARGC		;and update the "new argument count"
;
; calculate size of all files
;
CALCSZ:	MOV	B,H		;put nargc into BC
	MOV	C,L
	LXI	H,0		;init. HL as index (i) to first name
	SHLD	DUSAGE		;init. usage to 0
CALCS1:	PUSH	H		;save index
	PUSH	B		;and count
	CALL	IGET		;get address of this name in DE
	XCHG			;now put it in HL
	CALL	CMPRES		;compress attributes into DE
	PUSH	H		;save address for attribute word
	PUSH	D		;and save attribute word
	MOV	D,M		;grab the EXTENT byte from fcb image
	INX	H		;point to OVERFLOW EXTENT
	INX	H
	MOV	A,M		;grab that
	INX	H		;point to RECORDS left in last extent
	MOV	E,M		;grab it, too
	MOV	L,A		;make overflow extents a 16-bit number
	MVI	H,0
	MVI	B,5		;set up for multiply
	CALL	SHL16		;extents = overflow extents * 32
	MOV	A,D		;get extent byte
	ADD	L		;and add that in
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A
	MVI	B,7		;set up for multiply
	CALL	SHL16		;records = extents * 128
	MOV	A,E		;get records left
	ADD	L		;add that
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A
	XCHG			;put record count into DE
	POP	B		;get attribute word into BC
	POP	H		;point to address for att. word
	MOV	M,C		;install attribute word
	INX	H
	MOV	M,B
	INX	H
	MOV	M,E		;install record count
	INX	H
	MOV	M,D
	XCHG			;put record count back in HL
	LDA	BLM		;get block mask
	PUSH	PSW		;save a copy
	ADD	L		;and add it to record count
	MOV	L,A		;in order to round record count
	MOV	A,H		;up to the nearest block
	ACI	0
	MOV	H,A
	POP	PSW		;get blm back
	CMA			;complemented
	ANA	L		;mask record count - blm
	MOV	L,A
	MVI	B,3		;prepare for divide
	CALL	SHR16		;K bytes = records / 8
	XCHG			;put K bytes for this file in DE
	LHLD	DUSAGE		;get total usage for this DU:
	DAD	D		;add usage for this file
	SHLD	DUSAGE		;and save that
	POP	B		;restore count
	POP	H		;restore (i)ndex
	INX	H		;and bump to index next name
	DCX	B		;decrement name count
	MOV	A,B		;and test for zero
	ORA	C
	JNZ	CALCS1		;repeat for all names
	RET			;and ring is done
;
; -------------------------------------------------------------------------
; Compress file name attributes into a 16-bit word
;
; Entry:   HL points to file name
;
; Return:  DE = 16-bit word with bits 0 - 10 set to correspond
;		 to file name attributes for characters 10 - 0
;
;		15 14 13 12 11 10  9  8  7  6  5  4  3	2  1  0
;		-----------------------------------------------
;		 0  0  0  0  0	F  I  L  E  N  A  M  E	T  Y  P
;
;	     All registers are used.
;
;
CMPRES:	LXI	D,0		;initialize DE
	MVI	B,11		;initialize B as count for all char's.
CMPRS1:	MOV	A,M		;get a character from file name
	INX	H		;bump pointer
	RAL			;roll 8th bit (attribute) into carry
	MOV	A,E		;get low byte of att word
	RAL			;roll the attribute into att word low
	MOV	E,A		;and put the result back
	MOV	A,D		;get high byte of att word
	RAL			;roll bit 7 of low word into it
	MOV	D,A		;put result back
	DCR	B		;decrement count
	JNZ	CMPRS1		;and repeat for all file name characters
	RET			;then return
;
;		      end of file name module
;==========================================================================
; {3}			  Disk I/O module
;			  ---------------
; -------------------------------------------------------------------------
; Set CP/M Direct Memory Access address.
;
; Entry:  HL = the address of the next record to be read/written
;
; Return: none
;	  all regs. except PSW preserved
;
FACCESS:
	PUSH	B		;save all
	PUSH	D
	PUSH	H
	XCHG			;put DMA address in DE
	MVI	C,SETDMA	;do CP/M function to
	CALL	BDOS		;set the DMA address to our buffer
	POP	H		;restore
	POP	D
	POP	B
	RET
;
; -------------------------------------------------------------------------
; Set file attributes as necessary.
;
; Entry: HL = index (i) to file name
;	 ABASE: must be previously set to base address of pointer array
;
;	 The attribute word at FILENAME[0] + FATTS is used to determine
;	 whether attributes need to be changed.
;
;	 MYFCB should be ready to receive the file name.
;
; Return:  None
;	   Where necessary the attributes are changed and the attribute
;	   word is updated to reflect directory status.
;	   All registers except PSW are preserved.
;
NEWATT:
	PUSH	B		;save all
	PUSH	D
	PUSH	H
;
	CALL	IGET		;get address of file name in DE
	XCHG			;put it in HL
	CALL	CMPRES		;compress current attributes into DE
	MOV	A,E		;get current, low byte, into Acc.
	CMP	M		;compare with original
	JNZ	NEWAT1		;break if changed
	INX	H		;point to original, high byte
	MOV	A,D		;get current, high byte, into Acc.
	CMP	M		;compare with original
	JZ	NEWAT9		;quit now if no change necessary
	DCX	H		;else point back to original, low byte
;
NEWAT1:	MOV	M,E		;install new attribute byte
	INX	H
	MOV	M,D
	LXI	D,0-(FATTS+1)	;get offset back to beginning of name
	DAD	D		;add that to get address of name in HL
	PUSH	H		;save name's address
	LXI	D,MYFCB		;point to our fcb
	PUSH	D		;save fcb address
	INX	D		;now DE points to file name field in fcb
	MVI	B,FNAMSZ	;B = number of character in file name
	CALL	MOVE		;move the name into the fcb
	POP	D		;get fcb address back
	MVI	C,SETATT	;do CP/M set attribute function
	CALL	BDOS
	CALL	ILPRT		;tell the user what's going on
	DB	CR,LF,'Setting --> ',0
	POP	H		;restore file name
	CALL	PRNFN		;print entire file name
;
NEWAT9:	POP	H		;restore all
	POP	D
	POP	B
	RET			;done with one name
;
; -------------------------------------------------------------------------
; Set user.
;
; Entry:  DE = fcb address.  User number must be at fcb[0-1]
;
; Return: none
;	  all registers preserved except PSW
;
FSETUSR:
	PUSH	B		;save all
	PUSH	D
	PUSH	H
	DCX	D		;point to user as specified in fcb
	LDAX	D		;get it
	MOV	E,A		;put it in E
	MVI	C,SETUSR	;get CP/M function number
	CALL	BDOS		;set the user
	POP	H		;restore all
	POP	D
	POP	B
	RET			;and done
;
; -------------------------------------------------------------------------
; Set drive and user.
;
; Entry:  B = drive (0 = A)
;	  C = user
;
; Return:  DE and HL are preserved
;
SETDU:
	PUSH	D		;save regs.
	PUSH	H
	PUSH	B		;save original
	MOV	E,B		;put drive number into E
	MVI	C,SELDSK	;and select new drive
	CALL	BDOS
	POP	B		;get original back
	MOV	E,C		;put user number in E
	MVI	C,SETUSR	;and set new user
	CALL	BDOS
	POP	H		;and old regs.
	POP	D
	RET			;and done
;
; -------------------------------------------------------------------------
; Select user and see if a file exists.
;
; Entry:  DE = pointer to fcb[0].  Drive byte should be set, and
;	  fcb[0-1] must be set with user number.
;
; Return:  HL and DE are preserved
;	   BC and PSW are destroyed
;	   if found, Acc. = offset byte from BDOS search call
;	   if not found, CARRY SET
;
FXIST:
	PUSH	H		;save reg.
	PUSH	D		;save fcb address
	CALL	ZEROFCB		;set extent thru end of fcb to zero
	CALL	WILDEXT		;SPECIAL CASE - get any extent
	LXI	H,CMDBUF	;set DMA address
	CALL	FACCESS		;to CP/M's default buffer
	CALL	FSETUSR		;and set user
	MVI	C,SRCHFST	;get search-first function number
	CALL	BDOS		;do it
	POP	D		;fcb address now back in DE
	POP	H		;restore reg
	ADI	1		;set carry if result = 0ffh
	DCR	A		;but restore original offset in Acc.
	RET			;done
;
; -------------------------------------------------------------------------
; Translate the offset that CP/M gives us after a "search" call to an
; absolute address in the default CP/M DMA block.
;
; Entry:  Acc. = offset from search call
;
; Returns:  HL = address in DMA of the matching file name
;	    PSW destroyed, other registers preserved.
;
FNOFF:	PUSH	D		;save reg.
	ADD	A		;shift result * 2
	ADD	A		;* 4
	ADD	A		;* 8
	ADD	A		;* 16
	ADD	A		;* 32
	MOV	L,A		;put name offset in HL
	MVI	H,0
	LXI	D,CMDBUF	;and add this offset to DMA[0] address
	DAD	D
	POP	D		;restore old DE
	RET			;and return
;
; ------------------------------------------------------------------------
; Search the directory for all matches to a name.
;
; Entry:  DE = pointer to completed fcb, with user number at fcb[0-1].
;
; Return:  NARGC = number of matches found
;	   NARGBUF will contain the names in fcb-image fields.
;	   DE preserved, all other registers affected
;	   CARRY SET if no match was found.
;
DIRSRCH:
	CALL	FXIST		;see if file exists
	RC			;return now if not
;
	LXI	H,NARGBUF	;initialize IOBUF pointer
	SHLD	IOBUF		;(it points to end of NARGBUF)
DIRS1:	PUSH	D		;save the fcb address from harm
	CALL	FNOFF		;get address of file name in HL
	INX	H		;skip the drive byte
	XCHG			;put this address in DE
	LHLD	IOBUF		;get buffer pointer in HL
	XCHG			;now HL = file name, DE = buffer
	MVI	B,RCOFF		;B = size of name+typ+ext+s1+s2+rc
	CALL	MOVE		;move the name, etc., into narg. buffer
	XCHG			;get buffer pointer back in HL
	SHLD	IOBUF		;and store pointer for next time
	LHLD	NARGC		;get new argument count
	INX	H		;increment it
	SHLD	NARGC		;and re-save it
	XCHG			;then put it in DE
	LHLD	MAXNARG		;get max. count
	CALL	SUB16		;and find difference
	POP	D		;restore fcb address
	RZ			;and return if we've reached max. count
	PUSH	D		;else, save fcb address from harm
	MVI	C,SRCHNXT	;search for next occurrence
	CALL	BDOS
	POP	D		;get fcb address back
	INR	A		;test result for 0ffh, but make sure
	ORA	A		;carry is off since we found at least one
	RZ			;return if no more matches
	DCR	A		;else undo what the test did
	JMP	DIRS1		;and repeat
;
; -------------------------------------------------------------------------
; Log into a DU:
;
; Entry:  HL points to a possibly ambiguous file name
;	  in the form DU:NAME.TYP
;
; Return:  CARRY SET if error
;	   else disk system has been reset and DU: has been selected
;	   and all matching EXTENTS have been loaded into NARGBUF.
;	   NARGC will contain the number of matching EXTENTS
;
LOG:	PUSH	H		;save file name
	MVI	C,RSTDSK	;get function number to reset disk system
	CALL	BDOS		;do it
	POP	H		;restore file name
	LXI	D,MYFCB		;point to our local fcb
	CALL	DOWILD		;expand wild cards and load names
	RC			;return now if error
	LDA	MYFCB		;get DRIVE from fcb
	DCR	A		;in fcb A=1, so make A=0
	MOV	B,A		;put in B
	LDA	MYUSR		;get USER
	MOV	C,A		;into C
	CALL	SETDU		;select drive and user
	CALL	INQ		;update local tables
	RET			;all done
;
;			end of disk i/o module
;==========================================================================
; {4}			   Array Processing
;			   ----------------
; -------------------------------------------------------------------------
; Shell sort of an integer array.  Based on Kernighan and Ritchie,
; "The C Programming Language", page 58.
;
; Entry:  ABASE: and ASIZE: should be set with base address and size
;	  (in elements) of the integer array. Also, MYCOMP: must be
;	  loaded with the address of the compare routine that should
;	  be used. This routine expects access to variables GAP: and N:
;
; Return:  none
;	   all registers affected
;
SSORT:	LHLD	ASIZE		;get size of array
	SHLD	N		;initialize n
	SHLD	GAP		;initialize gap (gap = n)
;
; for (gap = n/2; gap > 0; gap /= 2)
;
SSORT1:	LHLD	GAP		;HL = gap
	MOV	A,H		;divide gap by 2: get high byte
	RAR			;roll it right
	MOV	H,A		;put result back
	MOV	A,L		;get low byte
	RAR			;roll it with carry from high byte
	MOV	L,A		;put it back
	SHLD	GAP		;save gap/2
	MOV	A,H		;test if gap > 0
	ORA	L
	RZ			;done if gap = 0
;
; for (i = gap; i < n; i++)
;
SSORT2:	XCHG			;DE = i [ = gap 1st time]
	LHLD	N		;get n into HL
	CALL	COMPARE		;test if (i < n)
	JNC	SSORT1		;NO - back to outer loop
	PUSH	D		;else save (i)
;
; for (j = i-gap; j >= 0 && comp(array[j],array[j+gap]) > 0; j -= gap)
;
SSORT3:	LHLD	GAP		;HL = gap, DE = (j) [(i) on 1st loop]
	CALL	SUB16		;now DE = (j - gap) [(i-gap) on 1st loop]
	JC	SSORT4		;if (j < 0) then break
	DAD	D		;HL = (j+gap)
	XCHG			;so now DE = (j+gap), HL = (j)
	CALL	SSCOMP		;compare (array[j+gap] - array[j])
	JNC	SSORT4		;move on if array[j+gap] >= array[j]
	CALL	ISWAP		;else swap the integers
	XCHG			;put (j) back in DE
	JMP	SSORT3		;and repeat
;
SSORT4:	POP	H		;retrieve (i)
	INX	H		;i++
	JMP	SSORT2		;repeat
;
;--------------------------------------------------------------------------
; Generic compare routine for Shell sort an other array routines.
;
; When this routine is called the HL and DE registers contain INDICES to
; two elements in the integer array.  The integers may be the objects that
; we want to compare OR they may be pointers to the objects we want to
; compare.  For maximum flexibility, a label is provided that will enable
; us to specify the address of the compare routine that should be used.
; The default routine is COMPARE:
;
; Entry:  HL = index (i)
;	  DE = index (j)
;	  MYCOMP: = address of specific compare routine
;
; Returns:	 carry set if (i > j)
;		 zero  set if (i = j)
;		 else	      (i < j)
;
;	  only PSW is affected
;
SSCOMP:	PUSH	H		;save (i)
	PUSH	D		;save (j)
;
	PUSH	D		;save (j) again
	CALL	IGET		;get base[i] in DE
	XCHG			;now HL = base[i], DE = (i)
	XTHL			;now HL = (j), stack = base[i]
	CALL	IGET		;get base[j] into DE
	POP	H		;get base[i] into HL
;
MYCOMP	EQU	$+1		;address to poke with specific routine
	CALL	COMPARE		;(if Shell (object[j+gap] - object[j]))
;
	POP	D		;restore original regs.
	POP	H
	RET			;and return with flags set
;
; -------------------------------------------------------------------------
; Linear search for an element in an array.
;
; Entry:  ASIZE: = size of array
;	  ABASE: = base address of array
;	  HL = pointer to key
;	  MYCOMP: should be loaded with address of appropriate compare
;	  routine.
;
;	  Note:  we must be able to modify array[asize] (after the end
;	  of the array because array indices are referenced to zero).
;
; Return: If MATCH, zero flag is RESET and HL = index (i) to matching
;	  element.  Zero flag is SET if NO MATCH.
;	  BC and DE are preserved.
;
ISRCH:	PUSH	D		;save DE from harm
	XCHG			;put pointer to key in DE
	LHLD	ASIZE		;get size of array
	CALL	IPUT		;put key after end of array (array[asize])
	XCHG			;size of array now in DE
	LXI	H,0		;init. index to first element in HL
ISRCH1:	CALL	SSCOMP		;compare array[asize] - array[i]
	JZ	ISRCH9		;break if equal
	INX	H		;else bump index to next element
	JMP	ISRCH1		;and search again
ISRCH9:	CALL	COMPARE		;compare (ASIZE - index)
	POP	D		;restore caller's DE
	RET			;index to match is in HL if NOT ZERO
;
; -------------------------------------------------------------------------
; Compare routine for the "FIND" function
;
; Entry:  HL = pointer to name in NARGBUF
;	  DE = pointer to file name we want to find
;	  The names should be in FCB format.
;
;	  Wild cards match anything and a zero in the target terminates
;	  the search and returns zero (MATCH == true).
;
; Returns: zero flag set if match
;	   all registers are modified
;
FCOMP:	MVI	B,FNAMSZ	;init. B = size of file name
FCOMP1:	LDAX	D		;get a byte from the key
	ORA	A		;test for zero
	RZ			;return - MATCH
	CPI	'?'		;wildcard?
	JZ	FCOMP2		;YES - it counts for anything
	MOV	C,A		;save the character from the key
	MOV	A,M		;get byte from NARGBUF
	ANI	07FH		;mask attribute
	CMP	C		;compare
	RNZ			;return if not the same
FCOMP2:	DCR	B		;characters match - decrement "bytes to do"
	RZ			;return if we've done them all
	INX	H		;else bump pointers
	INX	D
	JMP	FCOMP1		;and repeat
;
;--------------------------------------------------------------------------
; Compare of two file extents.
;
; Entry:  HL = pointer to first string
;	  DE = pointer to second string
;
; Returns:	 carry set if (i > j)
;		 zero  set if (i = j)
;		 else	      (i < j)
;
;	  only PSW is affected
;
XCOMP:	PUSH	B		;save all
	PUSH	D
	PUSH	H
	MVI	B,FNAMSZ	;get length of file name in B
	CALL	STRNCMP		;compare
	JNZ	XCOMP9		;return now if names are different
	MOV	B,M		;else get extent bytes
	LDAX	D		;into BC
	MOV	C,A
	INX	H		;point to s2 (overflow extent) bytes
	INX	H
	INX	D
	INX	D
	LDAX	D		;get one of them
	CMP	M		;compare to the other
	JNZ	XCOMP9		;return now if they are different
	MOV	A,C		;else get one extent
	CMP	B		;compare to the other
XCOMP9:	POP	H		;restore old regs.
	POP	D
	POP	B
	RET			;and return with flags set
;
;--------------------------------------------------------------------------
; Swap two integers in an array
;
; Entry: HL = index (i) and DE = index (j)
;
; Return:  only PSW is affected
;
ISWAP:	PUSH	B		;save caller's BC
	PUSH	H		;save (i)
	PUSH	D		;save (j)
;
	PUSH	H		;save (i) again
	PUSH	D		;save (j) again
	CALL	IGET		;get base[i] in DE
	XCHG			;now HL = base[i], DE = (i)
	XTHL			;now HL = (j), stack = base[i]
	CALL	IGET		;get base[j] into DE
	XCHG			;HL = base[j], DE = (j)
	XTHL			;HL = base[i], stack = base[j]
	XCHG			;DE = base[i], HL = (j)
	CALL	IPUT		;base[j] = base[i]
	POP	D		;DE = base[j]
	POP	H		;HL = (i)
	CALL	IPUT		;base[i] = base[j]
;
	POP	D		;restore caller's regs.
	POP	H
	POP	B
	RET
;
; -------------------------------------------------------------------------
; Get element (i) from an array of integers
;
; Entry:  HL = index (i)
;	  ABASE: = base address of the array
;
; Return: DE = abase[i], other register left intact
;
IGET:	PUSH	H		;save index
	XCHG			;put index in DE
	LHLD	ABASE		;get base address
	DAD	D		;add (index * 2) [ 2 = sizeof(int) ]
	DAD	D
	MOV	E,M		;retrieve the integer at that address
	INX	H
	MOV	D,M
	POP	H		;restore index
	RET			;and done
;
; -------------------------------------------------------------------------
; Save an element at position (i) in an array of integers
;
; Entry:  HL = index (i)
;	  DE = integer to save
;	  ABASE: = base address of the array
;
; Return: nothing, only PSW is affected
;
IPUT:	PUSH	H		;save index
	PUSH	D		;save integer
	XCHG			;put index in DE
	LHLD	ABASE		;get base address
	DAD	D		;add ( (i) * sizeof(int) )
	DAD	D		;where sizeof(int) = 2
	POP	D		;restore the integer
	MOV	M,E		;put the integer into the array address
	INX	H
	MOV	M,D
	POP	H		;restore index
	RET			;bingo
;
; -------------------------------------------------------------------------
; Delete element (i) from an integer array.
;
; Entry:  HL = index (i) (0 .. n)
;	  ASIZE: = size of array (in elements 1 .. n)
;
; Return:  nothing, only PSW is affected
;
IDEL:	PUSH	D		;save callers regs
	PUSH	H
;
	XCHG			;DE = index
	LHLD	ASIZE		;HL = size
	DCX	H		;HL = size - 1 = new size after delete
	SHLD	ASIZE		;save new size
	XCHG			;now DE = size, HL = index
	CALL	SUB16		;now DE = (size - index), HL = index
	JC	IDEL9		;return if (index > size)
;
IDEL1:	MOV	A,D		;test to see if swap count = zero
	ORA	E
	JZ	IDEL9		;YES - then done
	PUSH	D		;else save swap count (size-index)
	MOV	D,H		;let DE = index
	MOV	E,L
	INX	D		;now DE = index + 1, HL = index
	CALL	ISWAP		;swap adjacent elements
	INX	H		;HL = index + 1
	POP	D		;retrieve count of elements to swap
	DCX	D		;less one
	JMP	IDEL1		;and repeat
;
IDEL9:	POP	H		;restore old regs.
	POP	D
	RET
;
;		  end of array processing module
;==========================================================================
; {5}			  System Info Module
;			  ------------------
;
; Routines in this module will get the disk parameter info, read the allo-
; cation vector, find system memory limits, etc.
; ------------------------------------------------------------------------
; Get all system information
;
; Entry:  none
;
; Return:  local tables will be completed
;	   any registers may be affected
;
INQ:	CALL	MEMMAP		;get memory map
	CALL	GETDU		;get drive and user
	CALL	DSKINF		;get disk information
	RET
;
; -------------------------------------------------------------------------
; Print all system information
;
; Entry:  call INQ: first
;
; Return:  none - any regs. may be affected
;
PSTAT:	CALL	ILPRT		;print title
	DB	CR,LF
	DB	LF,TAB,'System information',CR
	DB	LF,TAB,'------------------',CR,LF
	DB	'MEMORY:',CR,LF
	DB	TAB,'TPA  = ',0
	LXI	H,TPA		;print TPA limits
	CALL	DHXOUT
	CALL	ILPRT
	DB	' - ',0
	LHLD	MYBDOS
	DCX	H
	CALL	DHXOUT
	CALL	ILPRT
	DB	CR,LF,TAB,'CCP  = ',0 ;print CCP limits
	LHLD	MYCCP
	CALL	DHXOUT
	CALL	ILPRT
	DB	' - ',0
	LHLD	MYBDOS
	DCX	H
	CALL	DHXOUT
	CALL	ILPRT
	DB	CR,LF,TAB,'S/N  = ',0 ;print Serial No. limits
	INX	H
	CALL	DHXOUT
	CALL	ILPRT
	DB	' - ',0
	LXI	D,5
	DAD	D
	CALL	DHXOUT
	CALL	ILPRT
	DB	CR,LF,TAB,'BDOS = ',0 ;print BDOS limits
	INX	H
	CALL	DHXOUT
	CALL	ILPRT
	DB	' - ',0
	LHLD	MYBIOS
	DCX	H
	CALL	DHXOUT
	CALL	ILPRT
	DB	CR,LF,TAB,'BIOS = ',0 ;print BIOS limits
	INX	H
	CALL	DHXOUT
	CALL	ILPRT
	DB	' - End of BIOS can''t be detected.'
;
	DB	CR,LF,LF,'IOBYTE:',0 ;print device assignments
	MVI	C,GETIOB	;get system iobyte
	CALL	BDOS
	LXI	H,DEVCON	;point to device name table
	MVI	B,5		;set up to do 4 devices
;
IOBLUP:	DCR	B		;decrement device count
	JZ	PDSK		;quit when all done
	PUSH	PSW		;save iobyte
	CALL	ILPRT		;print logical device name
	DB	CR,LF,TAB,0
	CALL	PRINT
	CALL	ILPRT
	DB	': is ',0
	POP	PSW		;retrieve iobyte
	PUSH	PSW		;and save it again
	PUSH	H		;save pointer to device names
	ANI	3		;mask 2 bits for one device
	ADD	A		;and multiply this
	ADD	A		;times 4 to get index into table
	MOV	E,A		;put the index into DE
	MVI	D,0
	DAD	D		;and add this to the base address
	CALL	PRINT		;then print the physical dev. name
	MVI	A,':'		;plus a colon
	CALL	TYPE
	POP	H		;restore base address
	LXI	D,16		;increment for next logical device
	DAD	D
	POP	PSW		;restore the iobyte
	RRC			;and roll bits for next device
	RRC			;into bits 0 and 1
	JMP	IOBLUP		;do it again
;
PDSK:	CALL	ILPRT		;we've filled the screen so let
	DB	CR,LF,LF,'Hit any key ...',0 ;user tell us to proceed
	CALL	GETCHAR
	CALL	ILPRT
	DB	CR,LF,LF,'DISK:',CR,LF,LF,'    ',0 ;print disk info
	LDA	DRIVE		;print drive letter
	ADI	'A'
	CALL	TYPE
	CALL	ILPRT
	DB	': Drive Characteristics',CR,LF,0
	LHLD	DSKSZR		;print all this other junk
	CALL	DECO5
	CALL	ILPRT
	DB	': 128 Byte Record Capacity',CR,LF,0
	LHLD	DSKSZK
	CALL	DECO5
	CALL	ILPRT
	DB	': Kilobyte Drive  Capacity (',0
	LHLD	DSM
	INX	H
	CALL	DECO0
	CALL	ILPRT
	DB	' blocks)',CR,LF,0
	LHLD	DIRSZ
	CALL	DECO5
	CALL	ILPRT
	DB	': 32  Byte Directory Entries (',0
	LHLD	DIRSZR
	CALL	DECO0
	CALL	ILPRT
	DB	' records, ',0
	LHLD	DIRSZK
	CALL	DECO0
	CALL	ILPRT
	DB	'k)',CR,LF,0
	LHLD	CHEKD
	CALL	DECO5
	CALL	ILPRT
	DB	': Checked  Directory Entries',CR,LF,0
	LHLD	EXTSZR
	CALL	DECO5
	CALL	ILPRT
	DB	': Records/ Extent',CR,LF,0
	LHLD	BLKSZR
	CALL	DECO5
	CALL	ILPRT
	DB	': Records/ Block (',0
	LHLD	BLKSZK
	CALL	DECO0
	CALL	ILPRT
	DB	'k/ Block)',CR,LF,0
	LHLD	SPT
	CALL	DECO5
	CALL	ILPRT
	DB	': Sectors/ Track',CR,LF,0
	LHLD	TOFF
	CALL	DECO5
	CALL	ILPRT
	DB	': Reserved Tracks',0
PFREE:	CALL	NEWLINE
	CALL	NEWLINE
	LHLD	NARGC		;print number of files
	CALL	DECO5
	CALL	ILPRT
	DB	': Files',CR,LF,0
	LHLD	DUSAGE
	CALL	DECO5
	CALL	ILPRT
	DB	': Kilobytes used on User',0
	LDA	USER		;print user number
	MOV	L,A		;(DECO wants 16 bits in HL)
	MVI	H,0
	CALL	DECO3
	CALL	ILPRT
	DB	':',CR,LF,0
	LHLD	KBUSED
	CALL	DECO5
	CALL	ILPRT
	DB	': Kilobytes used on Drive ',0
	LDA	DRIVE
	ADI	'A'
	CALL	TYPE
	CALL	ILPRT
	DB	':',CR,LF,0
	LHLD	KBFREE
	CALL	DECO5
	CALL	ILPRT
	DB	': Kilobytes Free',CR,LF,0
	JMP	OBEY0		;back to obey loop
;
; -------------------------------------------------------------------------
; Get Memory Map
;
; Entry:  none
;
; Return:  HL and DE destroyed
;
MEMMAP:	LHLD	BDOS+1		;get bdos address
	LXI	D,-6		;minus 6 = real start of BDOS (serial no.)
	DAD	D
	SHLD	MYBDOS		;save bdos address
	PUSH	H		;with an extra copy on stack
	LXI	D,-129		;subtract 128 + 1 bytes
	DAD	D		;(128 gives us a "safe" area)
	SHLD	MEMTOP		;and save that as top of usable memory
	POP	H		;restore bdos address
	LXI	D,-800H		;minus 0800h = start of CCP
	DAD	D
	SHLD	MYCCP		;save that
	LHLD	SBASE+1		;get warmstart address
	DCX	H		;minus 3 = start of BIOS
	DCX	H
	DCX	H
	SHLD	MYBIOS		;save that
	RET			;done
;
; -------------------------------------------------------------------------
; Get all disk info
;
; Entry:  none
;
; Return:  completes our local info table
;	   uses all registers
;
DSKINF:	MVI	C,GETDPB	;get function number
	CALL	BDOS		;to get DPB address in HL
	LXI	D,DPBSTRT	;point to beginning of our DPB
	MVI	B,DPBEND-DPBSTRT ;load size of our DBP
	CALL	MOVE		;move DPB into place
	LDA	BSH		;get block shift factor
	MOV	B,A		;into B
	PUSH	B		;save a copy of bsh on stack
	LXI	H,1		;block size in records
	CALL	SHL16		;= 1 << bsh
	SHLD	BLKSZR		;save that
	MVI	B,3		;block size in K bytes
	CALL	SHR16		;= blkszr >> 3
	SHLD	BLKSZK		;save it
	LHLD	DSM		;get max. block on disk
	INX	H		;+ 1 = disk size in blocks
	SHLD	DSKSZB		;save that
	POP	B		;retrieve bsh
	CALL	SHL16		;disk size in recs
	SHLD	DSKSZR		;= (dsm + 1) << bsh
	MVI	B,3		;disk size in K bytes
	CALL	SHR16		;= dskszr >> 3
	SHLD	DSKSZK		;squirrel it away
	LHLD	DRM		;get max. directory entry
	INX	H		;+ 1 = dir. size in entries
	SHLD	DIRSZ		;for a rainy day
	MVI	B,2		;dir. size in records
	CALL	SHR16		;= (drm + 1) >> 2
	SHLD	DIRSZR		;finders keepers
	MVI	B,3		;dir. size in K bytes
	CALL	SHR16		;= (drm + 1) >> 5
	SHLD	DIRSZK		;losers weepers
	LDA	EXM		;get extent mask
	INR	A		;+ 1
	MOV	L,A		;into HL
	MVI	H,0		;with high byte set to zero
	MVI	B,7		;records per extent
	CALL	SHL16		;= (exm + 1) << 7
	SHLD	EXTSZR		;saved
	LHLD	CKS		;get (DRM + 1)/4 (for removable media)
	MVI	B,2		;or (0)  (for fixed media)
	CALL	SHL16		;number of checked dir. entries
	SHLD	CHEKD		;= cks << 2
;
	MVI	C,GETALV	;get function number
	CALL	BDOS		;to retrieve allocation vector
	XCHG			;put ALV into HL register
	LHLD	DSM		;get maximum block on disk
	INX	H		;+ 1 = total blocks
	LXI	B,0		;initialize count of free blocks
;
INQFRE:	PUSH	D		;save the ALV address
	LDAX	D		;get a byte from the alloc. table
	MVI	E,8		;set up a count for 8 bits/byte
INQFR1:	RAL			;roll an alloc. bit into carry
	JC	INQFR2		;jump if block NOT FREE (bit = 1)
	INX	B		;else increment free count
INQFR2:	MOV	D,A		;save the alloc. byte from harm
	DCX	H		;decrement blocks left to check
	MOV	A,H		;and test for zero
	ORA	L
	JZ	INQFR3		;quit when all blocks are done
	MOV	A,D		;retrieve the alloc. byte
	DCR	E		;decrement bit count
	JNZ	INQFR1		;loop until all 8 bits done
	POP	D		;then retrieve ALV address
	INX	D		;set to next alloc. byte in table
	JMP	INQFRE		;and loop until all bytes are done
INQFR3:	POP	D		;then clean up the stack
	MOV	D,B		;move free count to DE
	MOV	E,C
	LHLD	DSM		;get max. blocks in HL
	INX	H		;+ 1 = total blocks
	XCHG			;now DE = total, HL = free
	CALL	SUB16		;now DE = (total - free) = blks. used
	LDA	BSH		;get bsh - 3
	SUI	3		;(referenced to K bytes not recs)
	MOV	B,A		;put that in b
	PUSH	B		;and save a copy
	CALL	SHL16		;Kilobytes free = blocks free << (bsh - 3)
	SHLD	KBFREE		;save Kb free
	POP	B		;retrieve (bsh - 3)
	XCHG			;put number of blocks used in HL
	CALL	SHL16		;Kilobytes used = blocks used << (bsh - 3)
	XCHG			;now DE = total Kb used, including DIR.
	LHLD	DIRSZK		;and HL = directory size in Kb
	CALL	SUB16		;now DE = (total Kb used - directory size)
	XCHG			;so now HL = Kb used by FILES
	SHLD	KBUSED		;save Kb used
	RET			;and we're done
;
; -------------------------------------------------------------------------
; Get current drive and user.
;
; Entry:  none
;
; Return:  DRIVE: and USER: are filled
;	   all registers may be affected
;
GETDU:	MVI	C,GETDSK	;get current disk drive number
	CALL	BDOS
	STA	DRIVE		;save it
	MVI	E,0FFH		;get current user number
	MVI	C,GETUSR
	CALL	BDOS
	STA	USER		;save it
	RET
;
;			end of system info module
;==========================================================================
; {6}		       Arithmetic/Logic subroutines
;		       ----------------------------
; -------------------------------------------------------------------------
; 16-bit subtract.
;
; Entry:  DE = minuend
;	  HL = subtrahend
;
; Return: DE = DE - HL
;	  BC and HL preserved, PSW destroyed
;
SUB16:	MOV	A,E		;subtract low nybble
	SUB	L
	MOV	E,A		;result in E
	MOV	A,D		;subtract high nybble, with borrow
	SBB	H
	MOV	D,A		;result in D
	RET
;
; -------------------------------------------------------------------------
; 16-bit logical shift RIGHT	0 --> [ HL ] --> [cf]
;
; Entry:  HL = value to shift
;	   B = number of times to shift
;
; Return: HL = result, B = 0
;	  PSW affected
;
SHR16:	MOV	A,B		;get count in Acc.
	ORA	A		;test for zero and clear carry flag
	RZ			;return when count is zero
	MOV	A,H		;get high byte
	RAR			;roll it right
	MOV	H,A		;put result back
	MOV	A,L		;get low byte
	RAR			;roll it with carry from high byte
	MOV	L,A		;put it back
	DCR	B		;decrement count
	JMP	SHR16		;repeat until count is zero
;
; -------------------------------------------------------------------------
; 16-bit logical shift LEFT  [cf] <-- [ HL ] <-- 0
;
; Entry:  HL = value to shift
;	   B = number of times to shift
;
; Return:  HL = result, B = 0
;	   PSW affected
;
SHL16:	MOV	A,B		;get count
	ORA	A		;test for zero
	RZ			;return when count is zero
	DAD	H		;shift HL left (multiply HL * 2)
	DCR	B		;decrement count
	JMP	SHL16		;repeat until count is zero
;
; -------------------------------------------------------------------------
; Unsigned compare of two integers.
;
; Entry:  HL = integer i, DE = integer j
;
; Returns:	carry set if (i > j)
;		zero  set if (i = j)
;		else	     (i < j)
;
COMPARE:
	MOV	A,D		;test high bytes
	CMP	H
	RNZ			;return now if (i <> j)
	MOV	A,E		;test low bytes
	CMP	L
	RET			;and done
;
; -------------------------------------------------------------------------
; Compare two STRINGS of a specified length.
;
; Entry:  HL points to string #1
;	  DE points to string #2
;	  B  = width (number of characters to compare)
;
; Return:  ---> if carry set  then HL > DE
;	   else if zero clear then HL < DE
;	   else if zero set   then HL = DE
;
;	   HL and DE are incremented to end or first unequal byte
;	   B and Acc. destroyed
;
STRNCMP:
	MOV	A,M		;get a byte from [HL]
	ANI	07FH		;mask parity bit
	MOV	C,A		;hold it
	LDAX	D		;get a byte from [DE]
	ANI	07FH		;mask parity bit
	CMP	C		;compare two bytes
	RNZ			;return if not the same
	INX	D		;increment pointers
	INX	H
	DCR	B		;and count
	JNZ	STRNCMP		;continue until B bytes are done
	RET
;
;		    end of arithmetic/logic module
;==========================================================================
; {7}			  Console I/O module
;			  ------------------
;--------------------------------------------------------------------------
; Print one file name, complete with size and attribute information
;
; Entry:  FNDX: = index (i) to the name
;
; Return: nothing, all but PSW are preserved
;
NAMOUT:	PUSH	D		;save caller's regs.
	PUSH	B
	PUSH	H
;
	LHLD	FNDX		;get index
	CALL	IGET		;then get address of name
	XCHG			;into HL
	SHLD	CPTR		;this will be the base of char. pointer
	MVI	A,FNAMSZ-1	;get index to last char. of file name
	CALL	NAMO5		;print file number and file name
	CALL	FENCE		;plus the "fence"
	MOV	A,M		;get the attribute word, low byte
	RRC			;and align first "type"
	RRC			;attribute with
	RRC			;bit 7
	MOV	C,A		;put result in C
	INX	H
	INX	H		;point to record count
	XCHG			;and put that in DE
	LXI	H,ATTAGS	;get address of attribute tag strings
	MVI	B,3		;count of tags to do
NAMO1:	MVI	A,SPACE		;print a space
	CALL	TYPE
	MOV	A,C		;get attribute byte
	RLC			;roll attribute bit into carry
	MOV	C,A		;save result
	PUSH	PSW		;save the flags
	CNC	PRINT		;if attribute is "off" print string
	INX	H		;increment pointer to next string
	INX	H
	INX	H
	INX	H
	POP	PSW		;restore flags
	JNC	NAMO2		;move on if "off" tag was printed
	CALL	VIDON		;else turn video attribute on
	CALL	PRINT		;print the "on" tag
	CALL	VIDOFF		;turn the video attribute off
NAMO2:	DCR	B		;decrement count
	JNZ	NAMO1		;and repeat till all attributes done
	CALL	FENCE		;print next "fence"
	MVI	A,SPACE		;and a space
	CALL	TYPE
	LDAX	D		;get record count
	MOV	L,A
	INX	D
	LDAX	D
	MOV	H,A
	CALL	DECO5		;print it, right justified 5 places
	CALL	ILPRT
	DB	' Recs ',0
	PUSH	H		;save "raw" record count
	LDA	BLM		;get block mask
	PUSH	PSW		;save a copy
	ADD	L		;and add it to record count
	MOV	L,A		;in order to round record count
	MOV	A,H		;up to the nearest block
	ACI	0
	MOV	H,A
	POP	PSW		;get blm back
	CMA			;complemented
	ANA	L		;mask record count - blm
	MOV	L,A
	MVI	B,3		;prepare for divide
	CALL	SHR16		;K bytes = records / 8
	CALL	DECO3		;print rounded K bytes
	CALL	ILPRT
	DB	'K (',0
	POP	H		;retrieve old record count
	PUSH	H		;resave it
	LXI	D,7		;and use blm for 1k
	DAD	D		;to round to nearest 1k
	MVI	B,3		;K bytes = records / 8
	CALL	SHR16
	CALL	DECO3		;and print real K bytes
	CALL	ILPRT
	DB	'K) ',0
	POP	H		;get old record count again
	MVI	B,7		;divide again
	CALL	SHR16		;LOGICAL EXTENTS = records / 128
	LDA	EXM		;get extent mask
NAMO3:	RRC			;divide logical extents by
	JNC	NAMO4		;1, 2, 4, 8, or 16
	PUSH	PSW		;to solve for PHYSICAL EXTENTS
	MVI	B,1
	CALL	SHR16
	POP	PSW
	JMP	NAMO3
NAMO4:	INX	H		;reference to 1
	CALL	DECO3		;print physical extents
	CALL	ILPRT
	DB	' ext',0
	CALL	FENCE		;end fence
	LDA	ATT		;get attribute index
	PUSH	PSW		;save it
	CALL	NAMO5		;re-print file name up to ATT character
	CALL	BAKSPC		;backspace to proper character
	POP	PSW		;retrieve att
	CPI	7		;at end of "name" field?
	CZ	BAKSPC		;YES - then backspace again to skip '.'
	MOV	E,A		;put ATT in DE to make a 16-bit number
	MVI	D,0
	LHLD	CPTR		;retrieve base char. pointer
	DAD	D		;and add ATT index to base
	SHLD	CPTR		;save this as new char. ptr
;
	POP	H		;restore old regs
	POP	B
	POP	D
	RET			;done printing file name, etc.
;
; print the file number and file name portions of the file name line
;
NAMO5:	PUSH	PSW		;save index to file name character
	MVI	A,CR		;make sure we're at the start of the line
	CALL	TYPE
	LHLD	FNDX		;get file index
	INX	H		;reference index to 1
	CALL	DECO3		;print the FILE NUMBER
	CALL	ILPRT		;print separator
	DB	'.  ',0
	LDA	DRIVE		;get drive
	MOV	B,A
	LDA	USER		;and user
	MOV	C,A
	CALL	PRNDU		;print them
	LHLD	CPTR		;get pointer to file name
	POP	PSW		;restore index to character
	CALL	PRNFNA		;print the file name or portion thereof
	RET			;and return
;
; -------------------------------------------------------------------------
; Get a string of characters from the console.	Warmboots if control-C
; is entered.
;
; Entry:  HL = address of buffer
;	  Acc. = maximum length of string
;
; Return: Acc. = number of characters in string
;	  HL   = address of string
;	  string will be all upper case, zero-terminated
;	  all regs. may be affected
;
GETS:	PUSH	B		;save caller's BC
	PUSH	H		;save address of buffer'
	MOV	B,A		;max. length in B
	MVI	C,0		;current length in C
GETS1:	CALL	GETCHAR		;get a character
	CPI	'C'-64		;control-C?
	JZ	SBASE		;YES - warm boot
	CPI	CR		;carriage return?
	JZ	GETS9		;YES - all done
	CPI	BS		;backspace?
	JZ	GETSBK		;YES - do it
	CPI	DEL		;delete ?
	JZ	GETSBK		;YES - treat like BS
	CPI	SPACE		;printable?
	JC	GETS1		;NO - then ignore it
	MOV	M,A		;else store it
	CALL	TYPE		;and type it
	INX	H		;increment pointer
	INR	C		;increment length
	DCR	B		;decrement max. length
	JNZ	GETS1		;and repeat if not zero
GETS9:	CALL	NEWLINE		;else do cr/lf
	MVI	M,0		;terminate the string
	MOV	A,C		;length in Acc.
	POP	H		;restore original address of buffer
	POP	B		;restore old BC
	RET			;and done
;
GETSBK:	MOV	A,C		;get length
	ORA	A		;test
	JZ	GETS1		;and do nothing if length = 0
	CALL	ILPRT		;else erase one character
	DB	BS,SPACE,BS,0
	DCR	C		;and decrement length
	DCX	H		;decrement pointer
	INR	B		;and increment max. length
	JMP	GETS1		;and get some more
;
; -------------------------------------------------------------------------
; Console character input.  Waits for input.  No echo.
;
; Entry:  none
;
; Return:  character is in Acc. CONVERTED TO UPPER CASE
;	   other regs. intact
;
GETCHAR:
	PUSH	B		;save old environment
	PUSH	D
	PUSH	H
GETCH1:	MVI	E,0FFH
	MVI	C,DCONIO	;get character from console
	CALL	BDOS
	ORA	A
	JZ	GETCH1
	ANI	07FH		;mask parity
	CALL	TOUPPER		;convert to upper case
	POP	H		;restore other stuff
	POP	D
	POP	B
	RET			;and done
;
; --------------------------------------------------------------------------
; Type a backspace on the console
;
; Entry: none
;
; Return: none, all registers preserved
;
BAKSPC:	PUSH	PSW		;save Acc.
	MVI	A,BS		;get backspace character
	CALL	TYPE		;type it
	POP	PSW		;restore Acc.
	RET			;all done
;
; -------------------------------------------------------------------------
; In-Line PRinT routine.
;
; Entry:  Stack = <message address>
;
; Return:  All registers except PSW are preserved.
;
ILPRT:	XTHL			;stack points to message so put in HL
	CALL	PRINT		;print it
	XTHL			;HL has return address so put it on stack
	RET			;and get old HL back, and done.
;
; -------------------------------------------------------------------------
; Print a string.
;
; Entry:  HL = pointer to ZERO TERMINATED string
;
; Return: HL += string length + 2 (points to the character after the zero)
;	  PSW destroyed. Rest preserved.
;
PRINT:	MOV	A,M		;get a character
	INX	H		;point to next
	ORA	A		;test for zero
	RZ			;return if zero
	CALL	TYPE		;else type the character
	JMP	PRINT		;and repeat
;
; -------------------------------------------------------------------------
; Type a character - supports video attribute
;
; Entry: none
;
; Return:  none
;	   all registers preserved
;
TYPE:	PUSH	B		;save regs.
	PUSH	D
	PUSH	H
;
	ORA	A		;test - is 8th bit set?
	JP	TYPE1		;NO - type as usual
	PUSH	PSW		;else, set video attribute ON
	LXI	H,ATTON
	CALL	PRINT
	POP	PSW		;retrieve character
;
TYPE1:	PUSH	PSW		;save the character
	ANI	7FH		;mask hi-bit for CRT - b/m
	MOV	E,A		;type the character
	MVI	C,CONOUT
	CALL	BDOS
	POP	PSW		;retrieve original character
;
	JP	TYPE2		;move on if 8th bit not set
	PUSH	PSW		;else, turn video attribute OFF
	LXI	H,ATTOFF
	CALL	PRINT
	POP	PSW
;
TYPE2:	POP	H		;restore regs.
	POP	D
	POP	B
	RET			;and return
;
; -------------------------------------------------------------------------
; Print a carriage return/line feed combination on console.
;
; Entry:  none
;
; Return:  All registers preserved.
;
NEWLINE:
	PUSH	PSW		;save caller's Acc/status
	CALL	ILPRT		;send it
	DB	CR,LF,0
	POP	PSW		;restore
	RET			;and that's it
;
; ---------------------------------------------------------------------------
; Print the "fence" character
;
; Entry: none
;
; Return: none
;	  PSW destroyed
;
FENCE:	CALL	ILPRT
	DB	' |',0
	RET
;
; ---------------------------------------------------------------------------
; Turn video attributes ON/OFF
;
; Entry: none
;
; Return: none, all regs. preserved
;
VIDON:	PUSH	H		;save all
	PUSH	PSW
	LXI	H,ATTON		;get address of attribute string
	CALL	PRINT		;send it
	POP	PSW		;restore all
	POP	H
	RET			;and done
;
VIDOFF:	PUSH	H		;similarly
	PUSH	PSW
	LXI	H,ATTOFF
	CALL	PRINT
	POP	PSW
	POP	H
	RET
;
;--------------------------------------------------------------------------
; Decimal output routines.
;
; Entry:  HL = number to type
;	  expects access to DWID: (1 byte)
;
; Return:  nothing
;	   all but PSW are preserved;
;
DECO0:	XRA	A		;call here if justify is not req'd
	STA	DWID
	JMP	DECO
;
DECO3:	MVI	A,3		;call here to output width 3
	STA	DWID
	JMP	DECO
;
DECO5:	MVI	A,5		;call here to output width 5
	STA	DWID
;
DECO:	PUSH	B		;save all
	PUSH	D
	PUSH	H
	LDA	DWID		;get decimal width
	ORA	A		;is it zero?
	JZ	DECOA		;YES - then we don't need to
	DCR	A		;decrement width count by one
	STA	DWID
DECOA:	LXI	B,-10		;get a minus 10 for subtract
	LXI	D,-1		;init. result to minus 1
;
DECOB:	DAD	B		;subtract 10
	INX	D		;and bump result
	JC	DECOB		;until overflow
	LXI	B,10		;add 10 back in
	DAD	B		;to leave remainder in HL
	XCHG			;swap - put result into HL
	MOV	A,H		;test result
	ORA	L		;for zero
	CNZ	DECO		;and call recursively until all digits done
	CALL	JSTFY		;justify the number to the right as necessary
	MOV	A,E		;get a result digit
	ADI	'0'		;add ascii offset
	CALL	TYPE		;send it
	POP	H		;and restore all
	POP	D
	POP	B
	RET			;that's all
;
JSTFY:	LDA	DWID		;get decimal width
	ORA	A		;is it already zero?
	RZ			;YEP - then we do nothing
	DCR	A		;else decrement the width count
	STA	DWID		;and save that so we can
	MVI	A,SPACE		;get a pad character in Acc.
	CALL	TYPE		;and send that
	JMP	JSTFY		;DWID times
;
; -------------------------------------------------------------------------
; Output a 4-digit hex number.
;
; Entry:  HL = number to output
;
; Return:  None
;	   all registers preserved
;
DHXOUT:
	PUSH	H		;save regs
	PUSH	PSW
	MOV	A,H		;get MSB
	CALL	HEXO		;send it
	MOV	A,L		;get LSB
	CALL	HEXO		;send it
	POP	PSW
	POP	H		;restore
	RET			;that's it
;
; -------------------------------------------------------------------------
; Output one hex byte to the console.
;
; Entry:  Acc. = byte to output
;
; Return:  none
;	   PSW destroyed, other registers unaffected
;
HEXO:
	PUSH	PSW		;save original digit
	RAR			;roll high nybble into low nybble
	RAR
	RAR
	RAR
	CALL	NYBBLE		;and send it
	POP	PSW		;restore original (to do low part)
NYBBLE:	ANI	0FH		;mask out the high nybble
	CPI	10		;is it < 10?
	JC	DIGOUT		;YES - ready to send digit
	ADI	7		;else, add alpha offset
DIGOUT:	ADI	'0'		;add ascii offset
	CALL	TYPE		;and send it to the console
	RET
;
;		      end of console i/o module
;==========================================================================
; {8}		      Various utility subroutines
;		      ---------------------------
; -------------------------------------------------------------------------
; Retrieve an ascii decimal digit.
;
; Entry:  HL = pointer to digit
;
; Return:  Acc. = legal decimal digit or CARRY SET if illegal
;
GETASCD:
	MVI	A,'9'		;is character > '9'
	CMP	M
	RC			;return if so
	MOV	A,M		;get the character
	SUI	'0'		;and subtract ascii offset
	RET			;and done
;
; -------------------------------------------------------------------------
; Convert character in Acc. to upper case
;
; Entry:  Acc. = character to convert
;
; Return: Acc. = converted character IF character was lower case
;	  other regs. unaffected
;
TOUPPER:
	CPI	'a'		;skip if not 'a' <= CHAR <= 'z'
	RC
	CPI	'z'+1
	RNC
	ANI	05FH		;else change to upper case
	RET
;
; -------------------------------------------------------------------------
; Move memory.
;
; Entry:  HL = source
;	  DE = destination
;	  B  = count of bytes to move
;
; Return:  HL += B, DE += B, B = 0, PSW destroyed.
;
MOVE:	MOV	A,M		;get source
	STAX	D		;put at destination
	INX	H		;bump pointers
	INX	D
	DCR	B		;decrement counter
	JNZ	MOVE		;until zero
	RET			;and finis
;
; -------------------------------------------------------------------------
; Pad (fill) memory.
;
; Entry: Acc. = byte to use for pad
;	 DE = starting location
;	 B  = count of bytes to fill
;
; Return:  DE += B, B = 0, character still in Acc., zero flag set
;
PAD:	STAX	D		;put byte at [DE]
	INX	D		;point to next
	DCR	B		;decrement count
	JNZ	PAD		;continue until all bytes done
	RET			;and return
;
; -------------------------------------------------------------------------
; Return POSition of byte in Acc. as it occurs in a string.
;
; Entry:  Acc. = byte to look for
;	  HL = pointer to ZERO-TERMINATED character string
;
; Return:  Acc. = position indexed 1 .. n if found or
;	   ZERO flag SET if NOT FOUND
;	   all other registers preserved
;
POS:	PUSH	B		;get a register to use
	PUSH	H		;save pointer to string
	MVI	B,0		;initialize position counter
	MOV	C,A		;byte to look for is in C
POS1:	INR	B		;bump counter
	MOV	A,M		;get byte from string
	INX	H		;point to next
	ORA	A		;test for terminator
	JZ	POSDUN		;quit if end of string
	CMP	C		;compare the two bytes
	JNZ	POS1		;do another if not equal
	MOV	A,B		;we found it - put position in Acc.
	ORA	A		;set flags (non-zero)
POSDUN:	POP	H		;restore old regs.
	POP	B
	RET			;and back we go
;
; -------------------------------------------------------------------------
; Print an error message and return.
;
; Entry:  Stack:   <a return address>
;		   <message address>  (similar to ILPRT)
;	  HL = pointer to another optional message OR 0000h
;
; Return:  CARRY always SET
;	   PSW and HL destroyed, other regs. preserved.
;
ERRET:	PUSH	H		;save HL (second optional message)
	CALL	ILPRT		;identify this as an error message
	DB	CR,LF,'ERROR:  ',BELL,0
	POP	H		;get 2nd error message off stack
	XTHL			;swap it with primary one
	CALL	PRINT		;print primary one
	POP	H		;get 2nd again
	MOV	A,H		;see if it is a good address
	ORA	L
	CNZ	PRINT		;print if HL > 0000
	CALL	NEWLINE		;print carriage return/line feed
	STC			;also set carry as error indicator
	RET			;and go give 'em the bad news
;
; -------------------------------------------------------------------------
; Print help menu.
;
; Entry:  none
;
; Return: none
;	  terminates with a jump to OBEY0 loop
;	  PSW is affected
;
MENU:	CALL	ILPRT		;print help message
	DB	CR,LF,LF	;
	DB	' <Ctrl-B> or <CR>     move forward one file',CR,LF
	DB	' <Ctrl-A> or <B>      move back one file',CR,LF
	DB	' <Ctrl-D> or <Ctrl-H> move the cursor left',CR,LF
	DB	' <Ctrl-C> or <SPACE>  move cursor right',CR,LF
	DB	' <Ctrl-T> or <T>      toggle file attribute',CR,LF
	DB	'             <A>      set file attributes',CR,LF
	DB	'             <F>      find a file',CR,LF
	DB	'             <I>      print disk information',CR,LF
	DB	'             <L>      log new DU:',CR,LF
	DB	'             <N>      next line auto-advance on/off',CR,LF
	DB	'             <S>      print free space',CR,LF
	DB	'             <X>      quit and return to CP/M',CR,LF
	DB	'             <?>      print this help menu',CR,LF
	DB	0		;<<=== terminating zero must be here...
	JMP	OBEY0		;all done
;
;			  end of utility routines
;==========================================================================
; {9}			     Initialized Data
;			     ----------------
; -------------------------------------------------------------------------
; Device assignments
;
DEVCON:	DB	'CON',0,'TTY',0,'CRT',0,'BAT',0,'UC1',0
DEVRDR:	DB	'RDR',0,'TTY',0,'PTR',0,'UR1',0,'UR2',0
DEVPUN:	DB	'PUN',0,'TTY',0,'PTP',0,'UP1',0,'UP2',0
DEVLST:	DB	'LST',0,'TTY',0,'CRT',0,'LPT',0,'UL1',0
;
; Attribute tags
;
ATTAGS:	DB	'R/W',0,'R/O',0
	DB	'DIR',0,'SYS',0
	DB	'NEW',0,'ARC',0
;
;==========================================================================
;			       Local stack
;			       -----------
;
VERS:	DB	'SSTAT - version ',VTENS,'.',VUNITS
	DB	'Copyright (C) David Jewett, III - 1986'
	DS	VERS + 128 - $
STACK	EQU	$
;
;==========================================================================
;			     Uninitialized Data
;			     ------------------
;
; Information on our environment
;
LOGDRV:	DS	1		;drive at startup
LOGUSR:	DS	1		;user at startup
DRIVE:	DS	1		;current drive
USER:	DS	1		;current user
OLDSP:	DS	2		;system's stack pointer at startup
IOBUF:	DS	2		;address of free memory space
MEMTOP:	DS	2		;address of top of usable memory
MYCCP:	DS	2		;address of CCP
MYBDOS:	DS	2		;address of BDOS
MYBIOS:	DS	2		;address of BIOS
;
DPBSTRT	EQU	$		;start of our copy of the DBP
SPT:	DS	2		;sectors per track
BSH:	DS	1		;block shift factor
BLM:	DS	1		;block mask
EXM:	DS	1		;extent mask
DSM:	DS	2		;disk size in blocks - 1
DRM:	DS	2		;directory size in entries - 1
AL0:	DS	1		;directory allocation mask low
AL1:	DS	1		;directory allocation mask high
CKS:	DS	2		;(DRM + 1)/4 or 0 (removable/fixed media)
TOFF:	DS	2		;number of reserved tracks
DPBEND	EQU	$		;end of our DPB
;
BLKSZK:	DS	2		;allocation block size in Kilobytes
BLKSZR:	DS	2		;allocation block size in 128-byte records
DSKSZB:	DS	2		;disk capacity in blocks
DSKSZK:	DS	2		;disk capacity in Kilobytes
DSKSZR:	DS	2		;disk capacity in 128-byte records
DIRSZ:	DS	2		;directory size in entries
DIRSZK:	DS	2		;directory size in Kilobytes
DIRSZR:	DS	2		;directory size in 128-byte records
KBFREE:	DS	2		;number of free Kilobytes on disk
KBUSED:	DS	2		;number of used Kilobytes on disk
CHEKD:	DS	2		;number of checked directory entries
EXTSZR:	DS	2		;records per extent
;
; Other data
;
DWID:	DS	1		;decimal output width
CPTR:	DS	2		;character pointer into file names
ATT:	DS	1		;attribute index (0-10)
FNDX:	DS	2		;file index (0-NARGC)
DUSAGE:	DS	2		;Kilobytes used on current DU:
;
; File control block.	Note that MYFCB - 1 = user number.
;
MYUSR:	DS	1		;user number
MYFCB:	DS	1		;drive number
	DS	8		;file name
	DS	3		;file type
	DS	1		;extent
	DS	1		;s1
	DS	1		;s2
	DS	1		;record count
	DS	16		;allocation info
;
; Support for integer array processing
;
ABASE:	DS	2		;base address of array
ASIZE:	DS	2		;size of array (in elements)
GAP:	DS	2		;gap for Shell sort
N:	DS	2		;N variable for Shell sort
;
; Argument Buffer Support
;
ARGBUF:	DS	128		;storage for command argument and strings
NARGC:	DS	2		;argument count after expand
NARGV:	DS	2		;pointer to pointers to file names
;
; New Argument Buffer (filenames) starts here.
;
NARGBUF	EQU	$
;
	END