; SFILE31.ASM - SuperFILE v31 for CP/M-80 - October 4, 1986
;
;
;	      NOTE: Read the SFILE.HIS file to follow
;		    the ongoing history of this pgm.
;
;
;	      NOTE: This version assembles with
;		    ASM, LASM, MAC, M80 or SLRMAC
;
;
;	ASEG		; Needed by the M80 assembler, ignore for others
;
VER:	EQU	31	; Version 3.1 86/09/04
;
; This program allows full wildcard searches of the directories and all
; library files on a CP/M system for a requested file, starting at A0:
; The user can optionally specify a single drive to be searched by in-
; cluding the drive name as a prefix to the search file.  This is based
; on SD-81, so credit is given to the MANY people that have worked on it
; in the past.
;
; This program is particularly beneficial on a RCPM with a large disk
; system.  You may wish to do the following:
;
;		 FILE.COM   -	set CKLBR option to NO
;		 SFILE.COM  -	set CKLBR option to YES
;
; This gives the users two separate programs to use - on large systems,
; it may take as long as 5-6 minutes to find a program if using SFILE,
; while searching for the same program may only take 30-40 seconds with
; FILE.
;
; Entering SFILE<ret> or SFILE ?<ret> will display a brief help message.
;
; The USER AREA PATCH TABLE is the same as in SD - if 0FFH is placed in
; an user location, that drive will be skipped.  This makes it possible
; to use the program on multi-disk systems where the drive numbers are
; not necessarily sequential.
;
; The program can now be optionally assembled to support named directories.
; If the RCPM uses 'CD <area_name>' (or something similar) to change areas,
; then the program will report the name of the area rather than d/u.  The
; list of directoriy names is currently 'hard wired' into the program and
; must be updated each time the area names are changed.  Name tables begin
; at ATABLE:; there is one table for each drive available and pointers to
; these tables must be inserted at PTRTBL:.

;=======================================================================
;			current revision
;
; 86/03/12  Added  option to display area names instead of  d/u.   Many 
;   v30     RCPM's now use CD.COM or similar utilities to change  areas 
;           on  the hard disk.   This makes d/u display of found  files 
;           rather  useless.   Names  must  be hardwired into  code  at 
;           locations ATABLE:,  BTABLE:, etc and pointers to each table 
;           at  PTRTBL:.   Also expanded 'ck' to 'checking';  too  many 
;           users asking "What does ck mean?"
;                                       - Ian Cottrell
;                                         ICBBS
;                                         613-990-9774
;
;=======================================================================
;
;
NO	EQU	0
YES	EQU	NOT NO		; (Cannot be 0FFH for some assemblers)
;
CR	EQU	0DH
LF	EQU	0AH
ESC	EQU	1BH
;
;
; To skip or include library searches
;
CKLBR	EQU	YES		; YES to include .LBR searches
				; NO  to skip looking in .LBR files
				;    (then name that version FILE.COM)
;
; ZCPR Compatibility - disregard MAXD and MAXU if ZCPR is NO
;
ZCPR	EQU	NO		; YES = ZCPR/BYE used for MAX D/U
MAXD	EQU	3DH		; Set to max drive location _/ /
MAXU	EQU	3FH		; Set to max user location ___/
;
;
; To skip or include $SYS search and/or WHEEL check
;
CKSYS	EQU	NO		; YES to include system files
CKWHL	EQU	NO		; YES if you use the WHEEL
WHEEL	EQU	3EH		; Normal WHEEL byte location
;
;
; To display $SYS or R/O files that have attributes set, in lower-case.
;
USELC	EQU	YES		; YES to show attribute(s) in lower case
;
;
; To use area names instead of DU:
;
;
NAMDIR	EQU	YES		; YES to use directory names
				; Be sure to change ATABLE:, BTABLE:, etc
				; to reflect the area names on your system
;
; BDOS equates
;
BDOS	EQU	0005H
FCB	EQU	005CH
TBUF	EQU	0080H
;
RDCHR	EQU	1		; Read character from console
WRCHR	EQU	2		; Write character to console
PRINTS	EQU	9		; Print string
CONST	EQU	11		; Check console status
RESET	EQU	13		; Reset disk system
SELDSK	EQU	14		; Select disk
OPEN	EQU	15		; 0FFH = not found
CLOSE	EQU	16		;   "	  "    "
SEARCH	EQU	17		;   "	  "    "
NEXT	EQU	18		;   "	  "    "
READ	EQU	20		; Not 0 = EOF
WRITE	EQU	21		; Not 0 = disk full
MAKE	EQU	22		; 0FFH	= directory full
CURDSK	EQU	25		; Get currently logged disk name
SETDMA	EQU	26		; Set current DMA
GALLOC	EQU	27		; Get address of allocation vector
CURDPB	EQU	31		; Get current disk parameters
CURUSR	EQU	32		; Get currently logged user number
READRN	EQU	33		; Get random read
RECORD	EQU	36		; Set random record number
;
ARCMAR	EQU	26		; Archive header marker byte
HDRSIZ	EQU	27		; Header size for archive (-4 if version = 1)
FCR	EQU	32
FRN	EQU	33
;
;
	ORG	0100H
;
	JMP	START
;
;
;-----------------------------------------------------------------------
;
; Drive/user area lookup table
;
; Configure the following table for your specific needs.  CP/M v2.2 can
; have 16 user areas (0-15), but ZCPR3 extends this to 32 user areas
; (0-31).  If the ZCPR equate is set YES, you can totally disregard the
; following table, if the CLWHL is also set YES.
;
; Assuming ZCPR is set NO, then insert the maximum user area allowed for
; each drive.  Put a 0FFH for all drives that are not available.  This
; allows use of non-sequential drive systems.
;
; With the CKWHL equate set YES, all user areas available will then be
; searched, regardless what is placed into the following table, when the
; WHEEL byte is set high by ZCPR.
;
LODRV	EQU	$		; Mark beginning of drive/user table
;
	DB	1		; 1)  A: drive maximum user area
	DB	0FFH		; 2)  B: drive maximum user area
	DB	0FFH		; 2)  C: drive maximum user area
	DB	0FFH		; 2)  D: drive maximum user area
	DB	0FFH		; 2)  E: drive maximum user area
	DB	0FFH		; 2)  F: drive maximum user area
	DB	0FFH		; 2)  G: drive maximum user area
	DB	0FFH		; 2)  H: drive maximum user area
	DB	0FFH		; 2)  I: drive maximum user area
	DB	0FFH		; 2)  J: drive maximum user area
	DB	0FFH		; 2)  K: drive maximum user area
	DB	0FFH		; 2)  L: drive maximum user area
	DB	0FFH		; 2)  M: drive maximum user area
	DB	0FFH		; 2)  N: drive maximum user area
	DB	0FFH		; 2)  O: drive maximum user area
	DB	15		; 2)  P: drive maximum user area
;
HIDRV	EQU	$		; Mark end of drive/user table
;
;
;-----------------------------------------------------------------------
;
;			Program starts here
;
;-----------------------------------------------------------------------
;
;
START:	LXI	H,0
	DAD	SP		; HL=old stack
	SHLD	STACK		; Save it
	LXI	SP,STACK	; Get new stack
;
	XRA	A
	STA	FNDFLG		; Clear file found flag
	STA	NEWUSR		; Make new user = 0
	STA	BASUSR		; Duplicate it if multi-disk mode
	MVI	C,48		; Get ZRDOS version
	CALL	BDOS
	MOV	A,L
	STA	ZRDFLG		; Save it
	MVI	C,12		; Get and save the CP/M version #
	CALL	BDOS
	MOV	A,L
	STA	VERFLG
	STA	DOPFLG		; Do not allow multi-drive yet
	CPI	20H		; Set carry if CP/M 1.4
	JC	VERERR		; Exit on earlier than 2.0
	LXI	H,FCB+1		; Point to name
	MOV	A,M		; Any specified?
	CPI	' '
	JZ	GUIDE		; So print help guide
	CPI	'?'
	JNZ	START1
	LDA	FCB+2		; Question mark by itself?
	CPI	' '
	JZ	GUIDE		; If yes, print help guide
;
START1:	PUSH	H		; Save FCB address
	LXI	D,SEARN		; Point to search name holding area
	MVI	B,11		; Size of file name, type
	CALL	MOVE		; Move it
	POP	H		; Restore fcb address
	MVI	E,0FFH		; Get current user number
	MVI	C,CURUSR
	CALL	CPM
	STA	OLDUSR		; Initialize startup user number
;
CLNON:	MVI	C,CURDSK
	CALL	CPM		; Get current disk number
	STA	OLDDSK		; Save for reset if needed
	LXI	H,FCB
	MOV	A,M		; Get drive name for directory search
	ORA	A		; Any specified?
	JNZ	START2		; Yes skip next routine
	XRA	A
	STA	DOPFLG		; Ok let multi-drive in
	MVI	A,1		; Otherwise, get disk 'A:'
;
START2:	MOV	M,A		; Put the absolute drive code in FCB
;
CKREST:	LXI	D,SIGNON
	CALL	PRINT
;
	 IF	CKWHL
	LDA	WHEEL		; WHEEL set?
	ORA	A
	JZ	CKRST1		; NO - don't bother with $SYS files
	 ENDIF			; CKWHL
;
	 IF	CKSYS OR CKWHL
	LXI	D,SIGN1
	CALL	PRINT
	 ENDIF			; CKSYS OR CKWHL

CKRST1:	LXI	D,SIGN2
	CALL	PRINT
;
	LDA	DOPFLG
	ORA	A
	CZ	SWAPEM		; Swap BDOS error vector tables
;
;
; Validate drive code and user area numbers from the drive table
;
NOOPT:	LXI	D,DRVMSG	; Get the drive/user error message
	PUSH	D
	LDA	FCB		; Get directory drive code
	DCR	A		; Normalize to range of 0-15 drives
;
	 IF	NOT ZCPR
	CPI	HIDRV-LODRV	; Compare with maximum drives on-line
	JNC	ERXIT		; Take drive error exit if out of range
	 ENDIF			; NOT ZCPR
;
	 IF	ZCPR
	LXI	H,MAXD		; Adddress to HL
	MOV	L,M		; MAXD to L
	INX	H		; Add one
	CMP	L		; Check it
	JNC	EX0		; Exit if out of range
	 ENDIF			; ZCPR
;
	LXI	H,USRMSG	; Switch to user # error message
	XTHL
	MOV	E,A		; Use drive code as index into table
	MVI	D,0
;
	 IF	NOT ZCPR
USRCK:	LXI	H,LODRV		; Point to base of drive/user table
	DAD	D
	MOV	A,M		; Get the maximum user # for this drive
	CPI	0FFH		; Check for skip drive
	JZ	ERXIT		; Exit if not wanted
	 ENDIF			; NOT ZCPR
;
	 IF	ZCPR
	LDA	MAXU
	SUI	1
	 ENDIF			; ZCPR
;
USRCK2:	ANI	1FH		; Make sure its in range 0-31
	STA	MAXUSR		; Save it for later
	LXI	H,NEWUSR	; Point to the directory user area
	CMP	M		; Compare it with the maximum
	JC	ERXIT		; Take error exit if user number illegal
	POP	D		; Destroy error message pointer
	LXI	H,FCB+1		; Point to name
;
;
; Make FCB all '?' to search for every file
;
WCD:	MVI	B,11		; Filename + filetype count
;
QLOOP:	MVI	M,'?'		; Store '?' in FCB
	INX	H
	DCR	B
	JNZ	QLOOP
;
GOTFCB:	MVI	A,'?'		; Force wild extent
	STA	FCB+12
	CALL	SETSRC		; Set DMA for BDOS media change check
	LXI	H,FCB		; Point to fcb drive code for directory
	MOV	E,M		; Get the drive code out of the FCB
	DCR	E		; Normalize drive code for select
	MVI	C,SELDSK	; Select the directory drive to retrieve
	CALL	CPM		; The proper allocation vector
	MVI	C,CURDPB	; It is 2.x or MP/M...request DPB
	CALL	BDOS
	INX	H
	INX	H
	MOV	A,M		; Get block shift
	STA	BLKSHF
	INX	H		; Bump to block mask
	MOV	A,M
	STA	BLKMSK		; Get it
	INX	H
	INX	H
	MOV	E,M		; Get max block #
	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 max # of entries in directory
;
;
; Re-enter here on subsequent passes while in the all-users mode
;
SETTBL:	LDA	FCB

	 IF	NOT NAMDIR
	ADI	'A'-1
	STA	PROC1
	LXI	D,PROCES	; Show the user what area is being
	CALL	PRINT		;   worked on
	LDA	NEWUSR
	STA	LSTUSR
	CALL	TYPUSR
	LXI	D,PROC2
	CALL	PRINT
	 ENDIF			; NOT NAMDIR

	 IF	NAMDIR
	CALL	PRTNAM
	LXI	D,PROCES
	CALL	PRINT
	 ENDIF			; NAMDIR

;
SETTB1:	LHLD	DIRMAX		; Get directory maximum again
	INX	H		; Directory size is DIRMAX+1
	DAD	H		; Double directory size
	LXI	D,ORDER		; To get size of order table
	DAD	D		; Allocate order table
	SHLD	TBLOC		; Name table begins after order table
	SHLD	NEXTT
	XCHG
	LHLD	BDOS+1		; Make sure we have room to continue
	MOV	A,E
	SUB	L
	MOV	A,D
	SBB	H
	JNC	OUTMEM
	LDA	NEWUSR		; Get user area for directory
	MOV	E,A
	MVI	C,CURUSR	; Get the user function
	CALL	CPM		; And set new user number
;
;
; Look up the FCB in the directory
;
	MVI	A,'?'
	LXI	H,FCB+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
	LXI	H,0
	SHLD	COUNT		; Initialize match counter
	CALL	SETSRC		; Set DMA for directory search
	MVI	C,SEARCH	; Get 'SEARCH FIRST' function
	JMP	LOOK		; And go search for 1st match
;.....
;
;
; Read more directory entries
;
MORDIR:	MVI	C,NEXT		; Search next
;
LOOK:	LXI	D,FCB
	CALL	CPM		; Read directory entry
	INR	A		; Check for end (0FFH)
	JZ	SPRINT		; If no more, sort & print what we have
;
;
; Point to directory entry
;
SOME:	DCR	A		; Undo prev 'INR A'
	ANI	3		; Make modulus 4
	ADD	A		; Multiply by 32 as each entry is 32
	ADD	A		;   bytes long
	ADD	A
	ADD	A
	ADD	A
	LXI	H,TBUF+1	; Point to buffer (skip to filename)
	ADD	L		; Point to entry
	ADI	9		; Point to .SYS byte
	MOV	L,A		; Save (can't carry to 'H')
;
	 IF	CKWHL
	LDA	WHEEL		; WHEEL set?
	ORA	A
	JNZ	SYSFOK		; YES - show $SYS files, too
	 ENDIF			; CKWHL
;
	 IF	CKSYS AND (NOT CKWHL)
	JMP	SYSFOK		; Show system files too
	 ENDIF			; CKSYS AND (NOT CKWHL)
;
	MOV	A,M		; Get .SYS byte
	ORA	A		; Check bit 7
	JM	MORDIR		; Skip that file
;
SYSFOK:	MOV	A,L		; Go back now
	SUI	10		; Back to user number (allocation flag)
	MOV	L,A		; Hl points to entry now
	LDA	NEWUSR		; Get current user
	CMP	M
	JNZ	MORDIR		; Ignore if different
	INX	H
;
;
; Move entry to table
;
	XCHG			; Entry to DE
	LHLD	NEXTT		; Next table entry to HL
	MVI	B,11		; Entry length (name, type, extent)
;
TMOVE:	LDAX	D		; Get entry character
;
	 IF	NOT USELC
	ANI	7FH		; Remove attributes
	 ENDIF			; NOT USELC
;
	MOV	M,A		; Store in table
	INX	D
	INX	H
	DCR	B		; More?
	JNZ	TMOVE
	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 extents
	MVI	B,7
	CALL	SHLL		; HL now has total records less last ext
	INX	D		; DE->> S1
	INX	D		; DE->> S2
	INX	D		; Point to record count
	LDAX	D		; Get it
	ADD	L
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A		; HL now has total records
	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	NEXTT		; Save updated table address
	XCHG
	LHLD	COUNT		; Bump the # of matches made
	INX	H
	SHLD	COUNT
	LXI	H,13		; Size of next entry
	DAD	D
	XCHG			; Future NEXTT is in DE
	LHLD	BDOS+1		; Pick up TPA end
	MOV	A,E
	SUB	L		; Compare NEXTT-TPA end
	MOV	A,D
	SBB	H
	JC	MORDIR		; If TPA end > NEXTT, loop back for more
;
OUTMEM:	CALL	ERXIT		; Exit if directory too large
	DB	'Memory',0
;.....
;
;
;-----------------------------------------------------------------------
;		s  u  b  r  o  u  t  i	n  e  s
;-----------------------------------------------------------------------
;
;
; Fetch character from console (without echo)
;
CINPUT:	LHLD	0001H
	MVI	L,9
	CALL	GOHL
	ANI	7FH
	RET
;.....
;
;
; Check for a CTL-C or CTL-S entered from the keyboard.  Jump to exit
; if CTL-C, pause on CTL-S.
;
CKABRT:	LHLD	0001H
	MVI	L,6		; Check status of keyboard
	CALL	GOHL		; Any key pressed?
	ORA	A
	RZ			; No, return to caller
	CALL	CINPUT		; Get character
	CPI	'C'-40H		; CTL-C?
	JZ	EX0		; If yes then quit
	CPI	'X'-40H		; CTL-X?
	JZ	EX0		; If yes then quit
	CPI	'S'-40H		; CTL-S?
	RNZ			; No, return to caller
	CALL	CINPUT		; Yes, wait for another char.
	CPI	'C'-40H		; Might be CTL-C
	JZ	EX0		; If yes then quit
	CPI	'X'-40H		; Might be CTL-X
	JZ	EX0		; If yes fall through and continue
	RET
;.....
;
;
; Test file extent for LBR
;
CKLBRY:	PUSH	H
	PUSH	D
	PUSH	B
	XCHG
	LXI	H,LBRTYP
	MVI	C,3
;
CKLBL:	LDAX	D
	ANI	7FH
	CMP	M
	JNZ	CKLBX
	INX	H
	INX	D
	DCR	C
	JNZ	CKLBL
CKLBX:	POP	B
	POP	D
	POP	H
	RET
;.....
;
;
; Test file extent for ARC
;
CKARC:	PUSH	H
	PUSH	D
	PUSH	B
	XCHG
	LXI	H,ARCTYP
	MVI	C,3
;
CKARL:	LDAX	D
	ANI	7FH
	CMP	M
	JNZ	CKARX
	INX	H
	INX	D
	DCR	C
	JNZ	CKARL
;
CKARX:	POP	B
	POP	D
	POP	H
	RET
ARCTYP:	DB	'ARC'
;.....
;
;
; Check to see if there indeed is a library file directory
;
CKLDIR:	MVI	B,11		; Length of file name
	MVI	A,' '		; Space
	INX	H
;
CKDLP:	CMP	M
	JNZ	LMLEXI
	DCR	B
	INX	H
	JNZ	CKDLP
;
;
; The first entry in the LBR directory is indeed blank.  Now see if the
; directory size is >0
;
	MOV	E,M		; File starting location low
	INX	H		; Must be zero here
	MOV	A,M		; File starting location high
	ORA	E		; Must be zero here also
	JNZ	LMLEXI
	INX	H
	MOV	E,M		; Get library size low
	INX	H		; Point to library size high
	MOV	D,M		; Get library size high
	MOV	A,D
	ORA	E		; Library must have some size
	JZ	LMLEXI
	DCX	D
	XCHG
	SHLD	SLFILE
	MVI	B,3
	LXI	H,17
	DAD	D
	PUSH	H
	LHLD	TLIBRA
	INX	H
	SHLD	TLIBRA
	POP	H
	JMP	LMTEST
;.....
;
;
; New compare routine
;
COMPARE: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
;
CMPLPE:	MOV	A,M
	ANI	7FH
	MOV	D,A
	LDAX	B
	ANI	7FH
	CMP	D
	INX	B
	INX	H
	RNZ
	DCR	E
	JNZ	CMPLPE
	RET
;.....
;
;
; Compare routine for sort
;
COMPR:	PUSH	H		; Save table address
	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
;
CMPLP:	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	CMPLP
;
NOTEQL:	POP	H
	RET			; Cond code tells all
;.....
;
;
; Entry to BDOS saving all extended registers
;
CPM:	PUSH	B
	PUSH	D
	PUSH	H
	LDA	ZRDFLG		; ZRDOS running?
	ORA	A
	JNZ	ZRD		; ZRDOS error trap and DOSs call
	CALL	BDOS
	MOV	B,A		; Save return code
	LDA	VERFLG		; Is this 3.0?
	CPI	30H
	MOV	A,B
	JC	CPM20		; No, exit normally
	CPI	0FFH		; It is 3.0 - was return code ff?
	JNZ	CPM20		; No, exit normally
	MOV	A,H		; 3.0 and A=FF - check for error code
	ORA	A
	JNZ	DSKERR		; Trap out if we got a physical error
	MOV	A,B		; Else continue normally
;
CPM20:	POP	H
	POP	D
	POP	B
	RET
;.....
;
;
; Start a new line
;
CRLF:	MVI	A,CR		; Send CR
	CALL	TYPE
	MVI	A,LF		; Send LF
	JMP	TYPE		; Exit to caller from TYPE
;.....
;
;
; Print HL in decimal with leading zero suppression
;
DECPRT:	XRA	A		; Clear leading zero flag
	STA	LZFLG
	LXI	D,-1000		; Print 1000'S DIGIT
	CALL	DIGIT
	LXI	D,-100		; Etc.
	CALL	DIGIT
	LXI	D,-10
	CALL	DIGIT
	MVI	A,'0'		; Get 1'S DIGIT
	ADD	L
	JMP	TYPE
;
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	TYPE		; Print digit
	LDA	SUPSPC		; Get space suppression flag
	ORA	A		; See if printing file totals
	RZ			; Yes, don't give leading spaces
	MVI	A,' '
	JMP	TYPE		; Leading zero, so print space
;
DIGNZ:	STA	LZFLG		; Leading zero flag so next zero prints
	JMP	TYPE		; And print digit
;.....
;
;
; Compute the size of the file/library and update our summary datum.
; This has been changed into a subroutine so that both the file size
; computation and a library size (when printing out library members)
; can be computed in k.
;
DOIT:	MOV	E,M		; Get extent #
	MVI	D,0
	INX	H
	MOV	A,M		; Get record count of last extent
	XCHG
	DAD	H		; # of extents times 16k
	DAD	H
	DAD	H
	DAD	H
	XCHG			; Save in DE
	LXI	H,BLKMSK
	ADD	M		; Round last extent to block size
	RRC
	RRC			; Convert from records to k
	RRC
	ANI	1FH
	MOV	L,A		; Add to total k
	MVI	H,0
	DAD	D
	LDA	BLKMSK		; Get records/blk-1
	RRC
	RRC			; Convert to k/blk
	RRC
	ANI	1FH
	CMA			; Use to finish rounding
	ANA	L
	MOV	L,A
	RET
;.....
;
;
; Recovery point from intercepted BDOS select and bad sector errors.
;
DSKERR:	LXI	SP,STACK	; Get out of BDOS' STACK
	JMP	EXIT		; And exit back to CCP
;.....
;
;
; Output the directory files we've matched.
;
ENTRY:	LHLD	COUNT
	DCX	H		; Dock file count
	SHLD	COUNT
	MOV	A,H		; Is this the last file?
	ORA	L
	JZ	OKPRNT		; If count=0, last file so skip compare
;
;
; Compare each entry to make sure that it isn't part of a multiple ex-
; tent file.  Go only when we have the last extent of the file.
;
	CALL	CKABRT		; Check for abort code from keyboard
	LHLD	NEXTT
	MVI	A,11
	CALL	COMPR		; Does this entry match next one?
	JNZ	OKPRNT		; No, print it
	INX	H
	INX	H		; Skip since highest extent last in list
	SHLD	NEXTT
	JMP	ENTRY		; Loop back for next lowest extent
;.....
;
;
ENTRYL:	LHLD	LCOUNT		; Get FCB count
	DCX	H		; Decrement it
	SHLD	LCOUNT
	MOV	A,H		; Is this the last file?
	ORA	L
	JZ	LBRTST		; If count=0, last file skip compare
	PUSH	B
	CALL	CKABRT		; Check for abort code from keyboard
	LHLD	NEXTL
	MVI	A,11
	CALL	COMPR		; Does this entry match next one?
	POP	B
	JNZ	LBRTST		; No, print it
	INX	H
	INX	H		; Skip, highest extent comes last in list
	SHLD	NEXTL
	JMP	ENTRYL		; Loop back for next lowest extent
;.....
;
;
; Error exit
;
ERXIT:	CALL	CRLF		; Space down
	POP	D		; Get pointer to message string
	CALL	PRINT		; Print it
	LXI	D,ERRMS1	; Print " error"
	CALL	PRINT
	CALL	CRLF		; Space down
;
;
; Exit - all done restore stack
;
EXIT:	LDA	DOPFLG		; Check multi disk mode
	ORA	A
	JNZ	EX0
	CALL	CKABRT		; Check for user abort first
;
	 IF	NOT ZCPR
	MVI	A,HIDRV-LODRV	; Get maximum drive code to search
	 ENDIF			; NOT ZCPR
;
	 IF	ZCPR
	LDA	MAXD
	 ENDIF			; ZCPR
;
	LXI	H,FCB		; Bump directory fcb drive code
	INR	M
	CMP	M		; Does next disk exceed maximum?
	JC	EX0
	JMP	NOOPT		; Search next disk if MAXDR not true
;.....
;
;
; Prints the ending results
;
EX0:	LXI	D,CLEAR
	CALL	PRINT

	 IF	NAMDIR
	LXI	D,AREA		; Show the last area searched
	CALL	PRINT
	 ENDIF			; NAMDIR

	 IF	NOT NAMDIR
	LXI	D,PROC1		; Show the last drive searched
	CALL	PRINT
	LDA	LSTUSR
	STA	NEWUSR
	CALL	TYPUSR		; Show the last user area searched
	LXI	D,PROC2
	CALL	PRINT
	 ENDIF			; NOT NAMDIR

	XRA	A		; Be sure space suppress flag is set
	STA	SUPSPC
;
	 IF	CKLBR
	LXI	D,TLMSG
	CALL	PRINT
	LHLD	TLIBRA
	CALL	DECPRT
	 ENDIF			; CKLBR
;
	LXI	D,TMMSG
	CALL	PRINT
	LHLD	TMATCH
	CALL	DECPRT
	LXI	D,TCMSG
	CALL	PRINT
	LHLD	TFILES
	CALL	DECPRT
;
	CALL	CRLF		; Just for neatness
	MVI	C,CONST		; Check console status
	CALL	CPM
	ORA	A		; Char waiting?
	MVI	C,RDCHR
	CNZ	CPM		; Gobble up character
	LDA	VERFLG		; Or error mode, depending on version
	CPI	30H
	JC	EXIT0
	MVI	C,45
	MVI	E,0		; Set error mode back to default
	CALL	CPM
	JMP	EXIT1
;
EXIT0:	LDA	DOPFLG		; If they were swapped
	ORA	A
	CZ	SWAPEM
;
EXIT1:	LHLD	STACK		; Get old stack pointer
	SPHL			; Move back to old stack
	RET			; And return to CCP
;.....
;
;
; Kludge to allow call to address in HL
;
GOHL:	PCHL
	JMP	CPM
;.....
;
;
GUIDE:	LXI	D,HELP		; Print help information
	CALL	PRINT
;
	 IF	CKWHL
	LDA	WHEEL		; WHEEL set?
	ORA	A
	JZ	GUIDE1		; NO - don't bother with $SYS files
	 ENDIF			; CKWHL
;
	 IF	CKSYS OR CKWHL
	LXI	D,HELP1
	CALL	PRINT
	 ENDIF			; CKSYS OR CKWHL
;
GUIDE1:	LXI	D,HELP2
	JMP	VERER1
;.....
;
;
; Close the library file
;
LBCLOSE:LXI	D,LBRFCB
	MVI	C,CLOSE
	CALL	CPM
	RET
;.....
;
;
; Exit library member printing
;
LBEXIT:	XRA	A		; Get a zero to...
	STA	SUPSPC		; Suppress leading spaces in totals
	RET
;.....
;
;
; At least one more file to output - can we put it on the current line?
;
LBGNXT:	POP	B
	POP	H
	JMP	LMTESA		; And go output another file
;
COMPS:	PUSH	H
	PUSH	D
	PUSH	B
	LXI	B,SEARN
	MVI	E,11
;
COMPS1:	MOV	A,M
	ANI	7FH
	MOV	D,A
	LDAX	B
	INX	B
	INX	H
	ANI	7FH
	CPI	'?'
	JZ	COMPS2
	CMP	D
	JNZ	COMPS3
;
COMPS2:	DCR	E
	JNZ	COMPS1
;
COMPS3:	POP	B
	POP	D
	POP	H
	RET
;.....
;
;
; Valid entry obtained - spit it out
;
LBRTST:	MVI	A,1		; Set not an .ARC file as default
	STA	ISARC		; in type of file flag.
	LHLD	NEXTL		; Get order table pointer
	MOV	E,M		; Get low order address
	INX	H
	MOV	D,M		; Get high order address
	INX	H
	SHLD	NEXTL		; Save updated table pointer
	LXI	H,8
	DAD	D
	CALL	CKLBRY
	JZ	LBRSET		; It's a library so skip .ARC test
	CALL	CKARC		; Check if current file is a .ARC
	JNZ	LBRNEX
	XRA	A
	STA	ISARC		; Save current file type is arc
LBRSET:	PUSH	D
	POP	H
;
;
; Saves the library file name into LBRFCB
;
	LDA	FCB
	LXI	D,LBRFCB	; To
	STAX	D
	INX	D
	MVI	B,11		; Length
	CALL	MOVE		; Do the move
	XCHG
	MVI	B,25
;
CLMFCB:	MVI	M,0
	INX	H
	DCR	B
	JNZ	CLMFCB
	CALL	SETLDMA
	LXI	D,LBRFCB	; Point to file
	MVI	C,OPEN		; Get function
	CALL	CPM		; Open it
	MVI	C,READ
	LXI	D,LBRFCB
	CALL	CPM
	CALL	SETFOP
	LXI	H,LBBUF
	MOV	A,M
	ORA	A
	JZ	CKLDIR		; Check directory present?
	LDA	ISARC		; Was file a .ARC file
	ORA	A
	JNZ	LMLEXI		; No so error
	MOV	A,M		; Get buffer byte again
	CPI	ARCMAR		; is an arc mark ?
	JZ	CKADIR		; Yep so Check directory present?
;
LMLEXI:	CALL	LBCLOSE
;
;
; Do next library file
;
LBRNEX:	LHLD	LCOUNT		; Check count
	MOV	A,H
	ORA	L
	JZ	LBEXIT		; No more, all done
	JMP	ENTRYL		; Else, get next .lbr file
;.....
;
;
LFMLOP:	LHLD	SLFILE		; Get
	MOV	A,L
	ORA	H
	JZ	LMLEXI
	DCX	H
	SHLD	SLFILE
	CALL	SETLDMA
	MVI	C,READ
	LXI	D,LBRFCB
	CALL	CPM
	CALL	SETFOP
	MVI	B,4		; Get file count per record
	LXI	H,LBBUF		; Get buffer starting address
;
LMTEST:	MOV	A,M		; Get member open flag
	ORA	A		; Test for open
	JZ	PRMNAM
;
LMTESA:	LDA	ISARC		; Test if we are doing an arc file
	ORA	A
	RZ			; Just return if .arc
	LXI	D,32		; Member not open get offset
	DAD	D		; To next and add it in.
	DCR	B		; Is buffer empty ?
	JNZ	LMTEST		; No so test next entry
	JMP	LFMLOP		; Yes get next buffer...
;
;.....
;
;
;------------------------------------------------
; Archive file subroutines
;------------------------------------------------
;
CKADIR:	XRA	A
	DCR	A
	STA	GETABL		; Say buffer is full (first read by lbr test)
	LHLD	TLIBRA		; Bump library count total
	INX	H
	SHLD	TLIBRA
ARCLP:	CALL	GET		; Get the next character from buffer
	CPI	ARCMAR		; Is it archive header marker?
	JNZ	LMLEXI		;  and abort if not
	CALL	GET		; Get header version
	ORA	A		; If zero, that's logical end of file,
	JZ	LMLEXI		;  and we're done
	LXI	D,ANAME		; Set to fill header buffer
	MVI	B,HDRSIZ	; Setup normal header size less file name
	CPI	1		; But test if version 1
	JNZ	GETHD1		; Skip if not version 1
	LXI	B,HDRSIZ-4	; Else, header is 4 bytes less
GETHD1:	CALL	GET		; Get header byte
	STAX	D		; Store in buffer
	INX	D
	DCR	B
	JNZ	GETHD1		; Loop for all bytes
	LXI	H,ARCFIL	; Prefill dummy arc fcb name with spaces
	MVI	B,11
FIXAN:	MVI	M,' '
	INX	H
	DCR	B
	JNZ	FIXAN
	MVI	B,5		; Prefill rest of dummy fcb with zero
FIXAE:	MVI	M,0
	INX	H
	DCR	B
	JNZ	FIXAE
	LXI	H,ANAME		; Get pointer to archive header buffer
	LXI	D,ARCFIL	; Point to our dummy fcb
	MVI	B,8		; Get name length
MANAME:	MOV	A,M		; Get character from header
	INX	H
	ORA	A
	JZ	AEDONE		; Nothing in buffer so we're done
	CPI	02EH		; Is the char a point
	JZ	DAEXT		; DO FILE EXTENT
	STAX	D
	INX	D
	DCR	B
	JNZ	MANAME
DAEXT:	LXI	D,ARCFIL+8	; Get dummy file extent address
	MVI	B,3
	MOV	A,M
	CPI	2EH
	JNZ	AELOP
	INX	H
AELOP:	MOV	A,M		; Fill in the file extent
	ORA	A
	JZ	AEDONE
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	AELOP
AEDONE:	LXI	H,ASIZE
	MOV	E,M		; Fetch BCDE from (HL)
	INX	H
	MOV	D,M
	INX	H
	MOV	C,M
	XRA	A		; Clear flags
	MOV	A,E		; Convert file length count in bytes
	RAL			;  to length in records for output
	MOV	A,D
	RAL
	MOV	E,A
	MOV	A,C
	RAL
	MOV	D,A
	XCHG
	SHLD	ARCFIL+13	; Save file length
	LXI	H,ARCFIL-1	; Point to dummy fcb
	CALL	PRMNAM		; List the file info
	LXI	H,ASIZE		; Get remaining file size
	MOV	A,M
	ANI	7FH
	LHLD	ARCFIL+13	; Save file length
	XCHG			; Save record offset
	LXI	H,GETABL	; Point to offset of last byte read
	ADD	M		; Add byte offsets
	CPI	80H		; Does it overflow current record?
	JC	NRAD
	SUI	80H		; Adjust pointer
	INX	D		; Bump record number
NRAD:	MOV	M,A		; Update buffer ptr for new position
	MOV	A,D		; Check record offset
	ORA	E
	JZ	LEXIT		; Return if none (still in same record)
SEEK2:	PUSH	D		; Save record offset
	LXI	D,LBRFCB
	MVI	C,RECORD	; Compute current "random" record no.
	CALL	CPM		; (I.e. next sequential record to read)
	LHLD	LBRFCB+FRN	; Get result
	DCX	H		; Adjust next record to current record
	POP	D		; Restore record offset
	DAD	D		; Compute new record no.
	JC	LMLEXI		; If >64k, it's past largest (8 Mb) file
	SHLD	LBRFCB+FRN	; Save new record no.
	MVI	C,READRN	; Read the random record
	CALL	GETREC
	ORA	A
	JNZ	LMLEXI		; File read error
	LXI	H,LBRFCB+FCR	; Point to current record in extent
	INR	M		; Bump for subsequent sequential read
LEXIT:	JMP	ARCLP		; Loop for next file
;.....
;
;
; Get next sequential byte from archive file
;
GET:	PUSH	B		; Save registers
	PUSH	D		
	PUSH	H
	LDA	GETABL		; Point to last byte read
	INR	A		; At end of buffer?
	CPI	80H
	CNC	GETNXT		; Yes, read next record and reset ptr
	STA	GETABL		; Save new buffer ptr
	MOV	L,A
	MVI	H,0
	LXI	D,LBBUF
	DAD	D
	MOV	A,M		; Fetch byte from there
	POP	H		; Restore registers
	POP	D
	POP	B
	RET			; Return
;.....
;
;
; Get next sequential record from archive file
;
GETNXT:	MVI	C,READ		; Setup read-sequential function code
	CALL	GETREC
	ORA	A
	JNZ	RDERR
	PUSH	PSW
	XRA	A
	DCR	A
	STA	GETABL
	POP	PSW
	RET
RDERR:	POP	H		; Strip getnxt return
	POP	H		; Clean up the get stack
	POP	D
	POP	B
	POP	H		; strip get calling address 
	JMP	LMLEXI		; Show error
;.....
;
;
; Get record (sequential or random) from archive file
;
GETREC:	PUSH	H
	PUSH	B
	CALL	SETLDMA		; Set library DMA address
	LXI	D,LBRFCB	; Setup FCB address
	POP	B		; Restore read function
	CALL	CPM		; Do it
	PUSH	PSW		; Save read status
	CALL	SETFOP		; Reset Print file DMA address
	POP	PSW		; Restore read status
	POP	H		; Restore buffer ptr
	RET
;.....
;
;
; Move characters from 'HL' to 'DE' length in 'B'
;
MOVE:	MOV	A,M		; Get a character
	STAX	D		; Store it
	INX	H		; To next 'FROM'
	INX	D		; To next 'TO'
	DCR	B		; More?
	JNZ	MOVE		; Yes, loop
	RET			; No, return
;.....
;
;
; Sort is all done - print entries that compare
;
NOOUT:	LHLD	COUNT
	SHLD	LCOUNT
	LXI	H,ORDER		; Initialize order table pointer
	SHLD	NEXTL
	SHLD	NEXTT
	JMP	ENTRY
;.....
;
;
; Directory for one user area completed.  If 'ALL USERS' option is se-
; lected, then go do another directory on the next user number until we
; exceed the maximum user # for the selected drive.
;
NXTUSR:	CALL	CKABRT		; Check for user abort first
	LDA	MAXUSR		; No abort - get maximum user number
	LXI	H,NEWUSR	; Bump directory user number
	INR	M
	CMP	M		; Does next user # exceed maximum?
	JNC	SETTBL		; Continue if more user areas to go
	LDA	BASUSR		; Reset base user number for the
	MOV	M,A		; Next directory search
;
;
; Directory for all user areas completed.  If the multi-disk option is
; enabled and selected, reset to the base user area and repeat the di-
; rectory for next drive on-line until we either exceed the drives in
; our LODRV-HIDRV table, or the BDOS shuts us down with a select or bad
; sector error, which will be intercepted back to the exit module.
;
NXTDSK:	LXI	H,FNDFLG	; Get file found flag
	MVI	M,0		; Clear file found flag for next drive
;
NDSK:	LDA	DOPFLG		; See if the flag is set now
	ORA	A
	JNZ	EXIT		; If yes, all done
	CALL	CKABRT		; Check for user abort first
	MVI	A,HIDRV-LODRV	; Get maximum drive code to search
	LXI	H,FCB		; Bump directory FCB drive code
	INR	M
	CMP	M		; Does next disk exceed maximum?
	JC	EXIT
	MOV	E,M
	MVI	D,0
	DCR	E
	LXI	H,LODRV
	DAD	D
	MOV	A,M
	CPI	0FFH
	JZ	NDSK		; Search next disk if MAXDR not true
	JMP	NOOPT
;.....
;
;
OKPRNT:	LHLD	NEXTT		; Get order table pointer
	MOV	E,M		; Get low order address
	INX	H
	MOV	D,M		; Get high order address
	INX	H
	SHLD	NEXTT		; Save updated table pointer
	XCHG			; Table entry to HL
;
;
; Put in user and drive printout here
;
	PUSH	H		; Save the current address
	LHLD	TFILES
	INX	H
	SHLD	TFILES
	POP	H
	CALL	COMPS		; Match what we are looking for ?
	JNZ	OKEXIT		; No, so don't print it
	PUSH	H
	LHLD	TMATCH
	INX	H
	SHLD	TMATCH
	POP	H
	MVI	A,CR
	CALL	TYPE
	LDA	FCB		; Precede new line with drive name

	 IF	NAMDIR
	CALL	PRTNAM		; Type area name
	LXI	D,AREA
	CALL	PRINT
	 ENDIF			; NAMDIR

	 IF	NOT NAMDIR
	ADI	'A'-1
	CALL	TYPE
	CALL	TYPUSR
	 ENDIF			; NOT NAMDIR

	MVI	A,':'		; Tag header with a colon and a space
	CALL	TYPE		; And exit back to entry
	MVI	A,' '
	CALL	TYPE

	 IF	NOT NAMDIR
	LDA	NEWUSR
	CPI	10
	JNC	OVER9
	MVI	A,' '
	CALL	TYPE
	 ENDIF			; NOT NAMDIR
;
OVER9:	MVI	B,8		; File name length
	CALL	TYPENM		; Type filename
	MVI	A,'.'		; Period after filename
	CALL	TYPE
	MVI	B,3		; Display 3 characters of filetype
	CALL	TYPEXT
	MOV	D,M
	INX	H
	MOV	E,M		; Size in DE (records)
	LDA	BLKMSK
	PUSH	PSW
	ADD	E
	MOV	E,A
	MOV	A,D
	ACI	0
	MOV	D,A
	POP	PSW
	CMA
	ANA	E
	MOV	E,A		; Size in DE
	MVI	B,3
;
SHRR:	MOV	A,D
	ORA	A
	RAR
	MOV	D,A
	MOV	A,E
	RAR
	MOV	E,A
	DCR	B
	JNZ	SHRR
	XCHG			; Get file size
;
;
; Output the size of the individual file.
;
	CALL	DECPRT		; Go print it
	MVI	A,'k'		; And follow with k size
	CALL	TYPE
	CALL	CRLF
	MVI	A,0FFH
	STA	FNDFLG		; Set file found flag
;
;
; One file output - test to see if we have to output another one.
;
OKEXIT:	LHLD	COUNT		; Get current file counter and test it
	MOV	A,H
	ORA	L
	JZ	PRTOTL		; If no more files exit to summary output
	JMP	ENTRY
;.....
;
;
OVER91:	MVI	B,8		; File name length
	CALL	TYPENM
	MVI	A,'.'		; Period after file name
	CALL	TYPE
	MVI	B,3		; Display 3 characters of filetype
	CALL	TYPEXT
	INX	H
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
;
;
; Output the size of the individual file.
;
	PUSH	D
	PUSH	H
	PUSH	H
	LHLD	LLENLOC
	PUSH	H
	POP	D
	POP	H
	DAD	D
	SHLD	LLENLOC
	POP	H
;
;
; New code added to convert .LIB members from records to 'k'.  Upon
; entry, member's size in records is in HL
;
	XCHG			; Put it in DE
	LXI	H,0		; Zero out HL
	MOV	A,E		; Put low byte of record count in a
	ADI	7		; Add seven to always round up 1k
	RRC			; Convert it to k
	RRC
	RRC
	ANI	1FH
	MOV	E,A		; And put it back
	MOV	L,D		; Get the high byte if any
	MVI	D,0		; Clean out the old resting place
	DAD	H		; Multiply it by 32 to convert to
	DAD	H		; Number
	DAD	H		; Of
	DAD	H		; k
	DAD	H		; Bytes
	DAD	D		; And add in the low byte
	POP	D
	CALL	DECPRT		; Go print it
	MVI	A,'k'		; And follow with size
	CALL	TYPE
	LXI	H,INLBF
	MVI	B,6
	CALL	TYPENM
	LXI	H,LBRFCB+1
	MVI	B,8		; File name length
	CALL	TYPENM
	MVI	A,'.'		; Period after file name
	CALL	TYPE
	MVI	B,3		; Display 3 characters of filetype
	CALL	TYPEXT
	CALL	CRLF		; So we can still see it!
	MVI	A,0FFH
	STA	FNDFLG		; Set file found flag
	JMP	LBGNXT
;.....
;
;
; Print string terminated with '0' character
;
PRINT:	LDAX	D
	ORA	A
	RZ			; If zero, finished
	CALL	TYPE		; Display on CRT
	INX	D
	JMP	PRINT
;.....
;
;
PRTLMEM: IF	NOT CKLBR
	XRA	A
	RET			; Skip library checks
	 ENDIF			; NOT CKLBR
;
	LXI	H,SEARN+8
	CALL	CKLBRY
	RZ
	LXI	H,ORDER		; Initialize order table pointer
	SHLD	NEXTL
	JMP	ENTRYL
;.....
;
;
PRMNAM:	PUSH	H		; Print member name and size
	PUSH	B
	CALL	CKABRT		; Check for abort code from keyboard
;
PRMNA1:	POP	B
	POP	H
	PUSH	H
	PUSH	B
	INX	H
	PUSH	H
	LHLD	TFILES
	INX	H
	SHLD	TFILES
	POP	H
	CALL	COMPS		; Match what we are looking for ?
	JNZ	LBGNXT
	PUSH	H
	LHLD	TMATCH
	INX	H
	SHLD	TMATCH
	POP	H
	MVI	A,CR
	CALL	TYPE
	LDA	FCB		; Precede new line with drive name

	 IF	NAMDIR
	CALL	PRTNAM		; Print area name
	LXI	D,AREA
	CALL	PRINT
	 ENDIF			; NAMDIR

	 IF	NOT NAMDIR
	ADI	'A'-1
	CALL	TYPE
	CALL	TYPUSR
	 ENDIF			; NOT NAMDIR

	MVI	A,':'		; Tag header with a colon and a space
	CALL	TYPE		; And exit back to entry
	MVI	A,' '
	CALL	TYPE

	 IF	NOT NAMDIR
	LDA	NEWUSR
	CPI	10
	JNC	OVER91
	MVI	A,' '
	CALL	TYPE
	 ENDIF			; NOT NAMDIR

	JMP	OVER91
;.....
;
; PRTNAM prints the name of the area being searched
;

	 IF	NAMDIR
PRTNAM:	PUSH	H		; Save regs
	PUSH	B
	DCR	A		; Adjust - 0=A, 1=B, etc
	LXI	H,PTRTBL	; Point to table of pointers
	ADD	A		; Calculate offset into table
	MOV	C,A
	MVI	B,0
	DAD	B
	MOV	A,M
	INX	H
	MOV	H,M
	MOV	L,A		; HL now points to name table for drive
	LDA	NEWUSR		; Now calc offset into that table
	STA	LSTUSR
	ADD	A		; *2
	ADD	A		; *4
	ADD	A		; *8
	MOV	C,A		; To BC
	MVI	B,0
	DAD	B
	MVI	B,8		; 8 characters in each name
	LXI	D,AREA		; Point to storage buffer
AREALP:	MOV	A,M		; Move name
	STAX	D
	INX	H
	INX	D
	DCR	B
	JNZ	AREALP
	XRA	A
	STAX	D		; Terminator
	POP	B
	POP	H
	RET
	 ENDIF			; NAMDIR
;.....
;
;
; Now check for libraries
;
PRTOTL:	LHLD	LCOUNT		; How many files did we see?
	MOV	A,H
	ORA	L
	CNZ	PRTLMEM		; Skip the .lbr check if none found
	XRA	A		; Get a zero to...
	STA	SUPSPC		; Suppress leading spaces in totals
	JMP	NXTUSR
;.....
;
;
; Reset Warm Boot Trap in ZRDOS
;
RESTRAP:PUSH	H
	PUSH	D
	PUSH	B
	PUSH	PSW
	MVI	C,52		; Reset warm boot trap
	CALL	BDOS
	POP	PSW
	POP	B
	POP	D
	POP	H
	RET
;.....
;
;
; For file output mode, return to old user area and set dma for the file
; output buffer.
;
SETFOP:	LDA	OLDUSR		; Get user number at startup
	MOV	E,A
	MVI	C,CURUSR
	CALL	CPM		; Reset the old user number
	RET
;.....
;
;
; Set the library file DMA address
;
SETLDMA:LDA	NEWUSR		; Get user area for directory
	MOV	E,A
	MVI	C,CURUSR	; Get the user function
	CALL	CPM		; And set new user number
	LXI	D,LBBUF
	MVI	C,SETDMA
	CALL	CPM
	RET
;.....
;
;
; Move disk buffer dma to default buffer for directory search operations
; and BDOS media change routines (necessary for pre-CP/M 2 systems while
; in file output mode with an active buffer).
;
SETSRC:	LXI	D,TBUF
;
SET2:	MVI	C,SETDMA
	JMP	CPM
;.....
;
;
; Set Warm Boot Trap in ZRDOS
;
SETTRAP:PUSH	H
	PUSH	D
	PUSH	B
	MVI	C,50		; Set warm boot trap to come here
	LXI	D,WBTRAP
	CALL	BDOS
	POP	B
	POP	D
	POP	H
	RET
;.....
;
;
; Shift HL left by B bits
;
SHLL:	DAD	H
	DCR	B
	RZ
	JMP	SHLL
;.....
;
;
; This sort routine is adapted from Software Tools by Kernigan and
; Plaugher.
;
SORT:	LHLD	SCOUNT		; Number 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?
	JZ	NOOUT		; 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	COMPARE		; Compare (J) and (JG)
	JP	L5		; If A(J)<=A(JG)
	LHLD	J
	XCHG
	LHLD	JG
	CALL	SWAP		; Exchange A(J) and A(JG)
	LHLD	J		; J=J-GAP
	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	SCOUNT		; 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
;.....
;
;
; Sort
;
SPRINT:	CALL	SETFOP		; Return to file output DMA & user #
	LHLD	COUNT		; Get file name count
	MOV	A,L
	ORA	H		; Any found?
	JZ	PRTOTL		; Exit if no files found
	PUSH	H		; Save file count
	STA	SUPSPC		; Enable leading zero suppression
;
;
; Initialize the order table
;
	LHLD	TBLOC		; 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 address to HL
	DAD	B		; Point to next entry
	XCHG
	XTHL			; Save table addr, fetch loop counter
	DCX	H		; Count down loop
	MOV	A,L
	ORA	H		; More?
	XTHL			; (restore table address, save counter)
	JNZ	BLDORD		; Yes, go do another one
	POP	H		; Clean loop counter off stack
	LHLD	COUNT		; Get count
	SHLD	SCOUNT		; Save as # to sort
	DCX	H		; Only 1 entry?
	MOV	A,L
	ORA	H
	JZ	NOOUT		; Yes, so skip sort
	JMP	SORT
;.....
;
;
; Swap entries in the order table
;
SWAP:	LXI	B,ORDER-2	; Table base
	DAD	H		; *2
	DAD	B		; + base
	XCHG
	DAD	H		; *2
	DAD	B		; + 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
;.....
;
;
SWAP20:	LHLD	BDOS+1		; Get pointer to base of BDOS
	INX	H		; Swap in the new pointer if running a
	MOV	E,M		; Program below the CCP
	INX	H
	MOV	D,M
	XCHG			; Now HL points to the proper vector
	MVI	L,9		; Point to record error vector
	LXI	D,VECTBL	; Exchanging with our own vector table
	MVI	A,4		; 4 bytes to swap
;
SWAPLP:	MOV	B,M		; Get byte from HL
	XCHG
	MOV	C,M		; Get byte from DE
	MOV	M,B		; Put byte from HL
	XCHG
	MOV	M,C		; Put byte from DE
	INX	H		; Bump exchange pointers
	INX	D
	DCR	A		; Dock counter
	JNZ	SWAPLP		; Continue swapping til done
	RET
;.....
;
;
; Trap BDOS select and sector error vectors to our own intercept routine
; so we can catch a reference to an illegal drive.
;
SWAPEM:	LDA	ZRDFLG		; See if ZRDOS running
	ORA	A
	RNZ			; Yes, quit this
	LDA	VERFLG		; Check version
	CPI	30H		; See if error mode call is available
	JC	SWAP20		; If not, use BDOS error vectors
	MVI	C,2DH
	MVI	E,0FFH		; Use set error mode call
	CALL	CPM		; Set "return code only" mode
	RET
;.....
;
;
; Output character in a to console, and optionally to printer and/or the
; output file.
;
TYPE:	PUSH	B
	PUSH	D
	PUSH	H
	PUSH	PSW		; Save the character to output
	CALL	TYPE1		; Send it to console
	POP	PSW		; Restore the output character
;
TYPRET:	POP	H		; Exit from type
	POP	D
	POP	B
	RET
;.....
;
;
; Print a string at HL of length B, retains any high bits set in the
; file extent - can be changed to lower case if USELC option is set YES.
;
TYPEXT:	MOV	A,M
	CALL	TYPE
	INX	H
	DCR	B
	JNZ	TYPEXT
	RET
;.....
;
;
; Print a string at HL of length B, removes any high bits set.
;
TYPENM:	MOV	A,M
	ANI	7FH
	CALL	TYPE
	INX	H
	DCR	B
	JNZ	TYPENM
	RET
;.....
;
;
; Output character
;
TYPE1:	 IF	USELC AND CKWHL	OR (NOT	CKWHL AND NOT ZCPR)
	ORA	A		; Check for attributes not set
	JP	TYPE2
	ANI	7FH		; Delete the attribute bit now
	CPI	'A'		; Change only from A-Z
	JC	TYPE2
	CPI	'Z'+1
	JNC	TYPE2		; Punctuation can change so leave it
	ORI	20H		; If attribute, make lower case
	 ENDIF			; USELC AND CKWHL, etc.
;
TYPE2:	MOV	E,A		; Get character into BDOS entry register
	MVI	C,WRCHR
	JMP	BDOS		; Call CONOUT via the BDOS
;.....
;
;
; Print the user number of the directory in decimal
;
TYPUSR:	LDA	NEWUSR
	CPI	10		; If user no. < 10, skip tens digit
	JC	DUX
	PUSH	B
	MVI	C,'0'-1
;
DUY:	INR	C		; Get tens digit
	SUI	10
	JNC	DUY		; Loop until we've gone too far
	ADI	10
	MOV	B,A		; Save units digit
	MOV	A,C		; Print tens digit
	CALL	TYPE
	MOV	A,B		; Get units back
	POP	B
;
DUX:	ADI	'0'
	JMP	TYPE
;.....
;
;
VERERR:	LXI	D,VERBAD	; Abort, bum CP/M version
;
VERER1:	CALL	PRINT
	JMP	EXIT1
;.....
;
;
; WBTRAP is where the ZRDOS returns control on warm boot (error)
;
WBTRAP:	LXI	H,DSKERR	; Return here after reseeting the trap
	PUSH	H		; Save DSKERR on stack
	JMP	RESTRAP
;.....
;
;
; ZRDOS Error Trap and System Call exits to CPM20
;
ZRD:	CALL	SETTRAP		; Set the warm boot trap
	CALL	BDOS		; Do what we're told
	CALL	RESTRAP		; Reset the trap
	JMP	CPM20		; Error free exit

;.....
;
;
;-----------------------------------------------------------------------
;
;			END OF PROGRAM CODE
;
;-----------------------------------------------------------------------
;
;
SIGNON:	DB	CR,LF,'SuperFILE '
	DB	VER/10+'0','.',VER MOD 10+'0',CR,LF,0
;
	 IF	CKSYS OR CKWHL
SIGN1:	DB	'includes $SYS files',CR,LF,0
	 ENDIF			; CKSYS OR CKWHL
;
SIGN2:
	 IF	CKLBR
	DB	'(also searches '
	 ENDIF			; CKLBR
;
	 IF	NOT CKLBR
	DB	'(does not search '
	 ENDIF			; NOT CKLBR
;
	DB	'lbr / arc) - ^X to abort',CR,LF,CR,LF,0
;.....
;
;
HELP:	DB	CR,LF,'  SuperFILE v'
	DB	VER/10+'0','.',VER MOD 10+'0',CR,LF
	DB	CR,LF,'  A FILE search program ',0
;
	 IF	CKSYS OR CKWHL
HELP1:	DB	'that includes $SYS files',CR,LF
	DB	'  ',0
	 ENDIF			; CKSYS
;
HELP2:
	 IF	CKLBR
	DB	'(also searches '
	 ENDIF			; CKLBR
;
	 IF	NOT CKLBR
	DB	'(does not search '
	 ENDIF			; NOT CKLBR
;
	DB	'lbr / arc) - ^X to abort',CR,LF,CR,LF
;
	 IF	CKLBR
	DB	'       (Use FILE.COM to skip lbr/arc checks)'
	 ENDIF			; CKLBR
;
	 IF	NOT CKLBR
	DB	'       (Use SFILE.COM to include lbr/arc checks)'
	 ENDIF			; NOT CKLBR
;
	DB	CR,LF,CR,LF,CR,LF
	DB	'  Examples to search all drive and user areas:',CR,LF
	DB	CR,LF,'          A>'
;
	 IF	CKLBR
	DB	'S'
	 ENDIF			; CKLBR
;
	DB	'FILE *.AQM',CR,LF,'          A>'
;
	 IF	CKLBR
	DB	'S'
	 ENDIF			; CKLBR
;
	DB	'FILE IMP*.*',CR,LF
	DB	CR,LF,'  Examples to search a single drive and all '
	DB	'user areas:',CR,LF
	DB	CR,LF,'          A>'
;
	 IF	CKLBR
	DB	'S'
	 ENDIF			; CKLBR
;
	DB	'FILE B:BYE5??.*',CR,LF,'          A>'
;
	 IF	CKLBR
	DB	'S'
	 ENDIF			; CKLBR
;
	DB	'FILE D:KMD*.*'
	DB	CR,LF,CR,LF,CR,LF,CR,LF,0

	 IF	NAMDIR
PTRTBL:	DW	ATABLE		; Location of name table for drive A
	DW	BTABLE		; Location of name table for drive B
	DW	CTABLE		; Location of name table for drive C
	DW	DTABLE		; Location of name table for drive D
	DW	ETABLE		; Location of name table for drive E
	DW	FTABLE		; Location of name table for drive F
	DW	GTABLE		; Location of name table for drive G
	DW	HTABLE		; Location of name table for drive H
	DW	ITABLE		; Location of name table for drive I
	DW	JTABLE		; Location of name table for drive J
	DW	KTABLE		; Location of name table for drive K
	DW	LTABLE		; Location of name table for drive L
	DW	MTABLE		; Location of name table for drive M
;
; Table of area names for each drive.  Each entry must be 8 characters
; long.  Number of entries must be equal to or greater than the
; maximum user area shown in HIDRV:
;
ATABLE:	DB	'FLOPPY  '	; Eight characters/entry
				; Users only access to A1:
BTABLE:
CTABLE:
DTABLE:
ETABLE:
FTABLE:
GTABLE:
HTABLE:
ITABLE:
JTABLE:
KTABLE:
LTABLE:
MTABLE:	DB	'BASE    '
	DB	'ASSEM   '
	DB	'WSTAR   '
	DB	'COMM    '
	DB	'EMPTY   '
	DB	'BASIC   '
	DB	'SCALC   '
	DB	'DBASE2  '
	DB	'RBBS    '
	DB	'MEXPLUS '
	DB	'GAMES   '
	DB	'NEWSOFT '
	DB	'        '
	DB	'ZCPR3   '
	DB	'DEVELOP '
	DB	'XFER    '	; Users access to M15:
	 ENDIF			; NAMDIR
;.....
;
;
; Message area
;
DRVMSG:	DB	'+++ Drive',0
ERRMS1:	DB	' '
ERRMS2:	DB	'Error',0
INLBF:	DB	'  in  '
LBRTYP:	DB	'LBR'
PROCES:	DB	CR,'Checking '

	 IF	NAMDIR
AREA:	DB	'        ',0
	 ENDIF			; NAMDIR

PROC1:	DB	' ',0
PROC2:	DB	': ',0

USRMSG:	DB	'User #',0

CLEAR:	DB	CR,'                  '

	 IF	NAMDIR
TUMSG:	DB	CR,LF,'    Finished after area ',0
	 ENDIF			; NAMDIR

	 IF	NOT NAMDIR
TUMSG:	DB	CR,LF,'    Finished after d/u = ',0
	 ENDIF			; NOT NAMDIR

TLMSG:	DB	CR,LF,'    Lbr / Arc searched = ',0
TMMSG:	DB	CR,LF,'    Files that matched = ',0
TCMSG:	DB	CR,LF,'    # of files checked = ',0
VERBAD:	DB	'+++ Needs CP/M 2.0 or Newer to RUN',0
;
;
;=======================================================================
;
;		     UNINITIALIZED DATA AREA
;
;=======================================================================
;
BASUSR:	DB	0		; Dupe of original dir. user # to search
BLKMSK:	DB	0		; Records/blk - 1
BLKSHF:	DB	0		; # shifts to mult by sec/blk
DOPFLG:	DB	0		;
FNDFLG:	DB	0		; File found flag
HITRAP:	DB	0		; Highlit trap (previously typed char)
LSTUSR:	DB	0		; To show last user area checked
LZFLG:	DB	0		; 0 when printing leading zeros
MAXUSR:	DB	0		; Max user # for drive from lookup table
NEWUSR:	DB	0		; User # selected by "$U" option
OLDDSK:	DB	0		; Holder for currently logged-in drive
OLDUSR:	DB	0		; Contains user number upon invocation
SUPSPC:	DB	0		; Leading space flag for decimal routine
VERFLG:	DB	0		; CP/M version number (0=pre-CP/M 2)
ZRDFLG:	DB	0		; ZRDOS version
;
BLKMAX:	DW	0		; Highest block # on drive
COUNT:	DW	0		; Entry count
DIRMAX:	DW	0		; Highest file # in directory
GAP:	DW	0		; Sort routine storage
I:	DW	0		; Sort routine storage
J:	DW	0		; Sort routine storage
JG:	DW	0		; Sort routine storage
LCOUNT:	DW	0
LLENLOC:DW	0		; Running total of .LBR length
NEXTL:	DW	0
NEXTT:	DW	0		; Next table entry
SCOUNT:	DW	0		; # to sort
SLFILE:	DW	0
TBLOC:	DW	0		; Pointer to start of name table
TEMP:	DW	0		; Save dir entry
TFILES:	DW	0
TLIBRA:	DW	0
TMATCH:	DW	0
VECTBL:	DW	DSKERR		; BDOS sector error intercept vector
	DW	DSKERR		; BDOS select error intercept vector
;
ISARC	DS	1		; Current file type flag for .arc
GETABL	DS	1
ANAME:	DS	13		; Name string
ASIZE:	DS	14		; Compressed bytes
ARCFIL	DS	16		; Dummy archive fcb
;
SEARN:	DS	11		; Holding area for search name
LBRFCB:	DS	36
LBBUF:	DS	80H
;
	DS	100		; Stack area
STACK:	DS	2		; Save old stack pointer here
;
ORDER	EQU	$		; Order table starts here
;
;
	END