;		         SUPER PURGE PROGRAM
;			       SPP
;			     2 AUG 88
;
;			    Gene Nolan
;
;
;		This program is being distributed ready
;		to use on a CP/M v2.2 computer with two
;		disk drives , no Z80DOS, and no ZCPR/ZCMD in use.
;
; SPP gives you the full power of SD/SDZD in specifying files to be erased.
; With one command you can erase EVERY FILE ON EVERY DRIVE/USER, so be
; carefull. If you are running Z80DOS, you can also use dates to specify
; which files to be considered for erasure.
;
;  NOTE: If WHEEL is TRUE and not set, this program WILL NOT EXECUTE,
;	 but merely display 'SPP ?' and return to CPM.
;
; Current versions of SPP automatically adjust for any block size and di-
; rectory length under CP/M 2.2,  3.0 or MP/M.	They can also handle any
; number of disk drives or skip those not available.  Current features:
;
;	 1) Searching individual or multiple drives and/or user areas
;	 2) Unconditional or optional disk system reset before execution
;	    begins
;	 3) Summary line output giving drive and user information, num-
;	    ber of files erased, how much space they consumed and free
;	    space remaining on the disk(s)
;	 4) Selecting or suppressing "system" and R/O files
;	 5) Accepting ambiguous filenames with or without a drive name
;	 6) Optional help menu with '?' or '//' if ZCPR33 option TRUE
;	 7) Summary line output optionally contains name of ZCPR3 named
;	    directory, if selected
;	 8) ZCPR3 named directory may be used in command line instead
;	    of DU: if selected
;	 9) Choose files based upon attributes 1-4
;	10) Z33 ENViorment support of wheel, maxdrv, maxusr location
;	11) Summary totals supplied as to number of files/total k erased
;
;-----------------------------------------------------------------------
;
;	ASEG			; Needed for M80 and RMAC, ignore error
;
	ORG	0100H
;
	JMP	START
;
NO	EQU	0
YES	EQU	NOT NO		; (Some assemblers don't like 0FFh)
;
; Define version number
;
MAIN	EQU	1		; Main block number
VER	EQU	00		; Current version
MONTH	EQU	08		; Month
DAY	EQU	02		; Day
YEAR	EQU	88		; Year
;
;-----------------------------------------------------------------------
;			     options
;
MAXDRV	EQU	NO		; *Yes if MAXD byte is supported
MAXUR	EQU	NO		; *Yes if MAXU byte is supported
WHEEL	EQU	NO		; *Yes if using ZCPR wheel byte

; If using equate ZCPR33 set to YES, then the following 3 will be
; taken from the ENV descriptor automaticaly if the corresponding
; MAXDRV, MAXUR, or WHEEL equate is set YES
MXDRV	EQU	3DH		; *Set to max drive address if MAXDRV=Yes
MXUSR	EQU	3FH		; *Set to max user  address if MAXUR=Yes
WHLOC	EQU	3EH		; *Set to wheel location if WHEEL=Yes

MXZUSR	EQU	15		; Maximum user # allowed with WHEEL set

EDATE	EQU	NO		; No, use USA date format for version mess.

PRBRDR	EQU	NO		; Yes = print quasi-borders for libraries
WMBOOT	EQU	NO		; If warmboot is needed on exit

	DB	'Z3ENV'		; For ZCPR3 Environment ID
	DB	1		; Class 1, External
Z3ENV:	DW	0		; Environment Address.	If using ZCPR33
				; This can be left as is.
;-------------------------------
;
; Drive/User area lookup table:
; ----------------------------
; Change the following table as appropriate for your version of CP/M.
; You can limit the maximum user area without wheel byte independently
; for any drive available.  Use 0FFh for drives that are not available.
;
;		CP/M  v2.2 has 16 user areas, 0-15
;		CP/M  v3.0 has 32 user areas, 0-31
;
; NOTE: Use your editor to move the "HIDRV" line below the correct
; number of drives for your system.  This not only saves time when the
; highest drive has been reached, but will display a drive/user error
; message which otherwise will not be shown.
;
LODRV	EQU	$		; Mark beginning of drive/user table

	DB	15		; Maximum user area for drive A
	DB	15		; "	  "    "    "	"     B
HIDRV	EQU	$		; Mark end of drive/user table
	DB	0FFH		; "	  "    "    "	"     C
	DB	0FFH		; "	  "    "    "	"     D
	DB	0FFH		; "	  "    "    "	"     E
	DB	0FFH		; "	  "    "    "	"     F
	DB	0FFH		; "	  "    "    "	"     G
	DB	0FFH		; "	  "    "    "	"     H
	DB	0FFH		; "	  "    "    "	"     I
	DB	0FFH		; "	  "    "    "	"     J
	DB	0FFH		; "	  "    "    "	"     K
	DB	0FFH		; "	  "    "    "	"     L
	DB	0FFH		; "	  "    "    "	"     M
	DB	0FFH		; "	  "    "    "	"     N
	DB	0FFH		; "	  "    "    "	"     O
	DB	0FFH		; "	  "    "    "	"     P
;
;
;-------------------------------
;
; Showing tagged attributes
; -------------------------
; Displaying files with tagged attributes ($R/O, $SYS, $ARC etc.) in an
; in an unique manner so they are easy to find, if present.
;
;	Example:
;		FILENAME.SyS	-  $SYS attribute set
;		FILENAME.doC	-  $SYS and $R/O both set
;		FILENAME.com	-  $SYS, $R/O and $ARC all set
;
; The following equates will permit SPP to display the files with tagged
; attributes in lower case letters (a-z) as in example above.
;
USELC	EQU	YES		; Allow lower case letters (a-z)
USELCW	EQU	YES		; *Allow lower case without wheel byte?
;
;-----------------------------------------------------------------------
;
; Reverse video options
; ---------------------
; The following equate will permit SPP to display the files with tagged
; attributes in either reverse video or bright/dim modes.  This will al-
; low any character tagged to be visible, as opposed to the USELD method.
; Up to 7 bytes for enter and exit video modes are provided.  These can
; be easily patched with DDT, etc.
;
REVID	EQU	NO		; Yes = inverse or bright/dim display
;
; The following equate will highlight/underline the summary line
;
ULINE	EQU	NO		; Yes = highlight/underline summary
;
;
; Reverse video control bytes
; ---------------------------
; If byte at RVON is 0, simple lower case will be used to display file
; attributes.
;
	 IF	REVID
RVON:	DB	0,0,0,0,0,0,0	; Up to 7 characters for ENTER REVERSE
	DB	0		; String Terminator MUST BE 0
;
RVOFF:	DB	0,0,0,0,0,0,0	; Up to 7 characters for EXIT REVERSE
	DB	0		; String Terminator MUST BE 0
	 ENDIF			; REVID
;
; If byte at ULON is 0, no highlighting/underlining will be used in the
; banner line.
;
	 IF	ULINE
ULON:	DB	0,0,0,0,0,0,0	; Up to 7 characters for ENTER ULINE
	DB	0		; String Terminator, MUST BE 0
;
ULOFF:	DB	0,0,0,0,0,0,0	; Up to 7 characters for EXIT ULINE
	DB	0		; String Terminator MUST BE 0
	 ENDIF			; ULINE
;
;-------------------------------
;
; If using Z80DOS and you want date stamping support, set the following
; to YES.
;
Z80DOS	EQU	NO
;
;-------------------------------
;
; If want to be able to specify files to be displayed based upon attribute
;	1 thru 4 , set the following to yes
;
FATTRIB	EQU	YES
;

;-------------------------------
;
; Z3CPR options
; -------------
; for ZCPR33 users - leave all set to NO if not using ZCPR3
;
ZCPR33	EQU	NO		; Allow named dir's and ENV support
ZCPR3	EQU	NO		; Allow named directory in command line
NDIRS	EQU	NO		; To display directory names
ZRDOS	EQU	NO		; Set to YES if using ZRDOS
Z3DRV	EQU	44		; Offset from ENV location to find drive max
Z3USR	EQU	45		; Offset from ENV location to find user max
Z3WHL	EQU	41		; Offset from ENV location to find wheel address
Z3NDR	EQU	21		; Offset from ENV location to find NDIR address
;
;			end of options
;-----------------------------------------------------------------------
;
; Reference items
; ---------------
RECORD	EQU	36
FRN	EQU	33
FCR	EQU	32
READRN	EQU	33
HDRSIZ	EQU	27
ARCMAR	EQU	26

TMPLT0	EQU	$		; Start of initialization template

	DB	'A'		; All-users option flag
	DB	'D'		; Multi-disk option flag

	DB	'H'		; Show areas from current to highest
	DB	'N'		; No page-pause option flag

	DB	'O'		; To show $SYS files only

	DB	'Q'		; To show only non-$ARC files

	DB	'R'		; Optional reset of disk system

	DB	'S'		; Include $SYS files

	DB	'T'		; Primary sort by file type

	DB	'V'		; Show SD version

	DB	'L'		; Include $R/O files

	 IF	Z80DOS
	DB	'='		; Look for exact match of date given
	DB	'+'		; Look for files of date GE date given
	DB	'-'		; Look for files of date LT date given
	DB	'!'		; Match with creation date
	DB	'%'		; Match with alteration date
	DB	'@'		; Match with access date
	DB	'Z'		; Do not show dates
	 ENDIF		;Z80DOS

	 IF	FATTRIB		; Allow spec of file attributes 1-4?
	DB	'1'		; Only files with attrib 1
	DB	'2'		; Only files woth attrib 2
	DB	'3'		; Only files with attrib 3
	DB	'4'		; Only files with attrib 4
	 ENDIF		;FATTRIB
;
; End of option lookup table
;
	DW	OUTBUF		; Next location in output buffer
	DB	128		; # of bytes left in output buffer
	DB	0,'DISK    DIR'	; Output Filename.typ
;
TMPLT1	EQU	$		; End of initialization data template

VERNAME:DB	13,10,'SPP',MAIN+'0'
	DB	VER/10+'0',VER MOD 10+'0',' -- '

	 IF	NOT EDATE
	DB	MONTH/10+'0',MONTH MOD 10+'0','/'
	 ENDIF			; NOT EDATE

	DB	DAY/10+'0',DAY MOD 10+'0','/'

	 IF	EDATE
	DB	MONTH/10+'0',MONTH MOD 10+'0','/'
	 ENDIF			; EDATE

	DB	YEAR/10+'0',YEAR MOD 10+'0'

	 IF	Z80DOS
	DB	', Z80DOS'
	 ENDIF

	 IF	ZCPR3 		;
	DB	', ZCPR3 Version'
	 ENDIF			; ZCPR3 

	 IF	ZCPR33 		;
	DB	', ZCPR33 Version'
	 ENDIF			; ZCPR33

	DB	0
;
;-----------------------------------------------------------------------
;			 Program starts here
;-----------------------------------------------------------------------
;
START:	LXI	H,0
	DAD	SP		; HL=old stack
	SHLD	STACK		; Save it
	LXI	SP,STACK	; Get new stack

	 IF	ZCPR33
	LHLD	Z3ENV		; Get ENV address
	PUSH	H
	LXI	D,Z3DRV		; Point to max drv byte
	DAD	D
	SHLD	Z3DRVL		; Save location away
	POP	H
	PUSH	H
	LXI	D,Z3USR		; Point to maxuser byte
	DAD	D
	SHLD	Z3USRL		; Save location away
	POP	H
	PUSH	H
	LXI	D,Z3WHL		; Point to address pointer of wheel
	DAD	D
	MOV	E,M		; Get address of wheel byte
	INX	H
	MOV	D,M
	XCHG
	SHLD	Z3WHLL		; Save it away
	POP	H
	 ENDIF		; ZCPR33

	 IF	NDIRS
	LHLD	Z3ENV		; Get Environment Address
	LXI	D,Z3NDR		; Point to named directory space
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M		; DE Now contains NDR Address
	INX	H
	MOV	A,M
	ADI	1
	STA	NUMDIR		; Maximum number of entries plus 1
	XCHG
	SHLD	NAMADR		; Keep Address for later
	 ENDIF			; NDIRS

	 IF	WHEEL
	XRA	A		; Start at line 0
	STA	LINCNT
	INR	A
	STA	NOPFLG		; And assume verify in case of error or
				; help wanted
	 IF	ZCPR33
	LHLD	Z3WHLL		; Get Z33 wheel location
	MOV	A,M		; Get the wheel
	 ENDIF		; ZCPR33

	 IF	NOT ZCPR33
	LDA	WHLOC		; Get the wheel
	 ENDIF		; NOT ZCPR33

	ORA	A
	JNZ	WHLOK		; NZ=wheel set, continue
	LXI	D,WHLERR
	CALL	PUTS
	JMP	EXIT3
WHLOK:
	ENDIF		; WHEEL


;
; See if help is wanted
;
	LXI	H,FCB+1		; Filename
	MOV	A,M		; 1st Character

	 IF	NOT ZCPR33
	CPI	'?'		; Is it "?"
	JNZ	INIT		; No, Continue
	INX	H		; Yes, Next Char
	MOV	A,M		; 2nd Character
	CPI	' '		; Is it " "
	JNZ	INIT		; If not, did not want help guide
	LDA	FCB+9		; Check for any extent
	CPI	' '
	JZ	HELPME		; If none, wanted help
	 ENDIF		; NOT ZCPR33

	 IF	ZCPR33
	CPI	'?'		; Is it "?"
	JNZ	CHKSLH		; No, Continue
	INX	H		; Yes, Next Char
	MOV	A,M		; 2nd Character
	CPI	' '		; Is it " "
	JNZ	INIT		; If not, did not want help guide
	LDA	FCB+9		; Check for any extent
	CPI	' '
	JZ	HELPME		; If none, wanted help
	JMP	INIT
CHKSLH: CPI	'/'		; Is it a slash?
	JNZ	INIT
	INX	H
	MOV	A,M		; two slashes gets help
	CPI	'/'
	JZ	HELPME
	 ENDIF		; ZCPR33

;
; Zero out the entire initialization data area
;
INIT:	LXI	H,DATA0		; Point to start of initialized data area
	PUSH	H		; Save for non-zero filling later
	MVI	C,DATA1-DATA0	; Data area length
	XRA	A		; Clear the "A" register

ZFILL:	MOV	M,A		; Null the address
	INX	H		; Pointer+1
	DCR	C		; One less to go
	JNZ	ZFILL

;
; Now copy non-zero initialization data from the template area
;
	POP	H		; Load A(DATA0)
	LXI	D,TMPLT0	; Load A(TMPLT0)
	MVI	C,TMPLT1-TMPLT0	; Template area length

NZFILL:	LDAX	D		; Load template byte
	MOV	M,A		; Move to data area
	INX	D		; Next location to store data
	INX	H		; Next location to get data
	DCR	C		; One less to go
	JNZ	NZFILL

	LXI	H,0		; Clear HL

	 IF	ZRDOS
	MVI	C,ZRDVER	; Get ZRDOS version
	CALL	BDOS
	MOV	A,L		; ZRDOS Version #
	STA	ZRDFLG		; Save it
	 ENDIF			; ZRDOS


	MVI	C,CPMVER	; Get CP/M  version
	CALL	BDOS
	MOV	A,L		; CP/M Version number
	STA	VERFLG		; Save it
	STA	SOHFLG		; Prevents initial unwanted CRLF
	CPI	20H		; Set carry if CP/M 1.4
	PUSH	PSW		; Save for BYE test
	MVI	E,0FFH		; Load current user number if CP/M 2
	MVI	C,STUSER	; Fall through with A=0 if not
	CNC	CPM		; Only if CP/M 2.0 or ZRDOS
	STA	OLDUSR		; Initial user number
	STA	NEWUSR		; New user = Initial user
	STA	BASUSR		; Directories
	POP	PSW		; Recover Version Flag

	 IF	ZCPR3 OR ZCPR33
	LDA	FCB+13		; Point to command line buffer (CLB)
	STA	NEWUSR
	 ENDIF			; ZCPR3

	 IF	NOT ZCPR3 AND NOT ZCPR33
	LXI	H,TBUF+1	; Point to command line buffer (CLB)
	MOV	A,M		; CLB Character
	CPI	'['		; CP/M 3.0 style delimiter
	JZ	CLOK		; (may follow command in CP/M 3.0)
	INX	H		; CLB pointer +1
	ORA	A		; Terminator?
	JNZ	CLOK		; No, continue
	MOV	M,A		; Yes, set 2nd terminator

CLOK:	LXI	D,FCB		; A(file control block)
	CALL	FNAME		; Process filename.typ
	MOV	A,B		; Disk specification
	CPI	0FFH		; Current?
	JZ	CLUS		; Yes
	STAX	D		; No, set disk specification

CLUS:	MOV	A,C		; User specification
	CPI	0FFH		; Current?
	JZ	CLNON		; Yes
	STA	NEWUSR		; No, set user specification
	STA	BASUSR
	 ENDIF			; NOT ZCPR3 AND NOT ZCPR33

CLNON:	MVI	C,CURDSK
	CALL	CPM		; Load current disk number
	STA	OLDDSK		; Save for reset if needed
	INR	A		; Adjust
	STA	OUTFCB		; Save directory file drive
	LXI	H,FCB		; A(file control block)
	MOV	A,M		; Load directory search drive
	ORA	A		; Any specified?
	JNZ	START1		; Yes, skip next routine
	LDA	OLDDSK		; Otherwise, get default disk
	INR	A		; Adjust
	JMP	START2

START1:	PUSH	PSW		; Save status
	MVI	A,1
	STA	DRVFLG		; Set DRVFLG = 1
	POP	PSW		; Load status

START2:	MOV	M,A		; Absolute drive code in directory FCB
;
; If at least one option is allowed,  scan command line for the option
; field delimiter. The option field delimiter is considered valid only
; if it is preceded by at least 1 space  (otherwise may be part of the
; directory filename).	 Any unrecognized options/illegal user numbers
; will be flagged.(We scan the command line buffer rather than the 2nd
; default FCB because all 8 options + 2 digit user number will not fit
; in the 2nd FCB name field).
;
	LXI	H,TBUF		; CLB pointer
	MOV	B,M		; CLB length
;
; Search for valid command line delimiter, if not found, assume no
; options.  Show help menu if single "?" entered.
;
SCNDOL:	INX	H		; CLB PTR+1
	DCR	B		; CLB LEN-1
	JM	DOPTN		; Exit if command line buffer empty
	MOV	A,M		; CLB Character
	CPI	'['		; CPM+ style delimiter?
	JZ	OPTDLM		; Yes
	CPI	'$'		; CPM2 style delimiter?
	JZ	SPB4		; Yes
	CPI	'/'		; ZCPR style delimiter?
	JNZ	SCNDOL		; No

SPB4:	DCX	H		; '$' found, space must precede
	MOV	A,M		; Previous character
	INX	H
	CPI	' '
	JNZ	SCNDOL		; No space, ignore '$'
;
; Valid delimiter found.  Scan the rest of the buffer for options.
; Errors past this point cause an abort.
;
OPTDLM:	XCHG			; DE = CLB pointer (swap pointers)

SCNOPT:	INX	D		; CLB PRT+1
	DCR	B		; CLB LEN-1
	JM	DOPTN		; If option field exhausted, exit

SCNAGN:	LDAX	D		; Load option character
	CPI	' '		; Is it " "?

	 IF	Z80DOS
	JZ	LOKDAT		; Space, go look for date info
	 ENDIF		;Z80DOS

	 IF	NOT Z80DOS
	JZ	SCNOPT		; Yes, Ignore it
	 ENDIF		;NOT Z80DOS

	CPI	']'		; CPM+ style terminator?
	JZ	SCNOPT		; Options may follow terminator
	LXI	H,OTBL-1	; OTBL pointer
	MVI	C,OEND-OTBL+1	; OTLB length

NOMACH:	INX	H		; OTLB pointer+1
	DCR	C		; OTLB length-1
	JZ	CLERR		; Error if option table end
	CMP	M		; Compare with table entry
	JNZ	NOMACH		; If no match, check next
	MVI	M,0		; Else, activate the option
	JMP	SCNOPT		; Continue scan
;.....
;
; Playback the command line up to the character that stopped the scan
; and exit
;
CLERR:	XRA	A		; Clear "A" register
	INX	D		; Tag end of CLB
	STAX	D		; With terminator
	CALL	CRLF		; New line
	LXI	D,ERRMS2	; 'Error'
	CALL	PUTS
	LXI	D,ERRTAG	; '->'
	CALL	PUTS
	LXI	H,TBUF+1	; Playback CLB to error point

CLELP:	MOV	A,M		; Character
	ORA	A		; Zero?
	JZ	CLEX		; Yes, exit
	CALL	PUTCHR		; No, output to console
	INX	H		; CLB pointer+1
	JMP	CLELP		; Continue

CLEX:	MVI	A,'?'		; Tag line with a '?' field
	CALL	PUTCHR
	CALL	CRLF		; New Line


;;;;;	JMP	0000H		; And reset CCP, all finished
	JMP	EXIT2

	 IF	Z80DOS
LOKDAT:	INX	D
	LDAX	D		; Check to see if * was entered meaning
	CPI	'*'		; use current system time
	JNZ	LOKDAT1		; NZ=no
	PUSH	D		; Save pointer to input line
	LXI	D,ASCII		; Tell Z80DOS to put time here
	MVI	C,105
	CALL	5		; Go get the time
	LXI	D,ASCII
	LDAX	D		; Get LSB of JDAY
	MOV	L,A
	INX	D
	LDAX	D		; Get MSB of JDAY
	MOV	H,A
	POP	D		; Get input pointer back
	INX	D		; Point ot next
	LDAX	D
	CPI	'-'		; Does operator want a subtraction?
	JNZ	LOKDAT2		; NZ=no
	PUSH	H
	INX	D
	CALL	EVAL10		; Yes go get number
	MOV	E,A
	XRA	A
	MOV	D,A
	MOV	A,L
	SBB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	JMP	LOKDAT2		; And continue
LOKDAT1:
	call	eval10		; convert month to binary
	ORA	A		; month can't be 0
	JZ	BADDATE
	CPI	13		 ; can't be >12
	JNC	BADDATE
	STA	MONTHS		; store month
	LDAX	D		; End of input line?
	ORA	A
	JZ	BADDATE		; Z=yes, a no-no
	INX	D		; Skip /
	call	eval10		; convert
	ORA	A		; day can't be 0
	JZ	BADDATE
	CPI	32		; or >31
	JNC	BADDATE
	STA	DAYS1		; store day
	LDAX	D		; End of input line?
	ORA	A
	JZ	BADDATE		; Z=yes, a no-no
	INX	D		; Skip /
	call	eval10
	STA	YEARS1		; store year
	LXI	H,YEARS1		; pt at date
	call	bin2jul		; get jul date in hl
LOKDAT2:
	SHLD	DATCHK
	JMP	DOPTN
EVAL10:
	XRA	A
	MOV	B,A		; B holds current number input
EVAL1:	LDAX	D		; Get input
	CPI	'/'		; / is seperator
	JZ	DEVAL10		; Z= done
	ORA	A
	JZ	DEVAL10		; Z= at end of line
	SUI	'0'		; Verify ascii 0-9
	JC	BADDATE
	CPI	10
	JNC	BADDATE
	INX	D
	MOV	C,A		; Old*10+new
	MOV	A,B
	ADD	A
	ADD	A
	ADD	B
	ADD	A
	ADD	C
	MOV	B,A		; B has current
	JMP	EVAL1
DEVAL10:
	MOV	A,B
	RET
BADDATE:
	PUSH	D
	LXI	D,BDTMES
	CALL	PUTS
	POP	D
	JMP	CLERR
BDTMES:
	DB	13,10,13,10
	DB	' *** Illegal Date Entered, form MM/DD/YY or MM/D/YY or M/DD/YY'
	DB	13,10,13,10,0
;
;	Binary to Julian Date routine.
;
; >>	hl -> yr,mo,da in bin
; << 	hl = Julian date
;
;	Convert to 8080 code from the original
;	BCD2JUL
;	by Bridger Mitchel and Howard Goldstein - 4/16/88
;
BIN2JUL:
	PUSH	PSW
	PUSH	B
	PUSH	D
	MOV	A,M		; A=yr
	INX	H
	MOV	C,M		;c = mo
	INX	H
	PUSH	H		;save ptr to day
	PUSH	PSW		;save year
;
; set hl= initial julian value of 77/12/31
;
	LXI	H,0
	SUI	78
	JZ	B2JUL3
	JNC	B2JUL0
	ADI	100		;<78, assume next century
B2JUL0:	MOV	B,A		;b = # yrs > 78
	MVI	A,1		;init modulo 4 counter
	LXI	D,365		;days/yr
B2JUL1:	DAD	D		;calc julian val. of  (yr/01/01 - 1)
	INR	A
	ANI	3		;every 4 yrs,
	JNZ	B2JUL2
	INX	H		;..add 1 for leap year
B2JUL2:	DCR	B
	JNZ	B2JUL1
;
; 	hl now = # days in years before current year
;
B2JUL3:	POP	PSW
	ANI	3		;if current yr == leap year
	JNZ	B2JUL5
	MOV	A,C
	CPI	3		;..and mo >= march
	JC	B2JUL5
	INX	H		;..add the extra day (Feb 29)
;
B2JUL5:	MOV	B,C		; b = month = # months +1 to sum
	LXI	D,DPERMO	;point at table
	JMP	B2JUL7
;
B2JUL6:	CALL	ADDHL		;add # days in this month
	INX	D		;bump tbl ptr
B2JUL7:	DCR	B
	JNZ	B2JUL6
;
	POP	D		;ptr to day
	CALL	ADDHL
	POP	D
	POP	B
	POP	PSW
	RET

ADDHL:	LDAX	D		;add day of current month
;
ADDA2HL:
	ADD	L
	MOV	L,A
	RNC
	INR	H
	RET

;
; table of days per month (non-leap year)
;

DPERMO:	DB	31		;jan
	DB	28		;feb
	DB	31		;mar
	DB	30		;apr
	DB	31		;may
	DB	30		;jun
	DB	31		;jul
	DB	31		;aug
	DB	30		;sep
	DB	31		;oct
	DB	30		;nov
	DB	31		;dec

	 ENDIF		;Z80DOS



;.....
;
; Options input or not specified, and associated flags set.
;
; If D-option, swap error vectors, then start at drive A if no
; drive specified on command line.
;
DOPTN:	LDA	DOPFLG		; If multi-disk flag set,
	ORA	A		; Need to set error traps
	JNZ	AOPTN		; If not, go check A-option
	CALL	SWAPEM		; Swap BDOS error vector tables
	LDA	DRVFLG		; Directory drive specified?
	ORA	A
	JNZ	AOPTN		; No, don't reset
	MVI	A,1		; Yes, Set FCB to A:
	STA	FCB
;
; Start user at 0 if A-option selected without U-option
;
AOPTN:	LDA	AOPFLG		; Check All-users option
	ORA	A
	JNZ	COPTN		; Jump if not
	LDA	HOPFLG		; Asking to show all from current?
	ORA	A
	JZ	COPTN		; If yes, do not reset "A" to zero
	XRA	A		; No, Start at user 0
	STA	NEWUSR
	STA	BASUSR

COPTN:
	MVI	A,'k'

COPTN1:	STA	FSIZEC		; Indicator char after size
;
; The following optionally resets the disk system.  The reset must
; be done OUTSIDE of the multiple drive loop if the $F option is
; enabled because CP/M 1.4 will clobber the DMA buffer on reset.
;
	LDA	ROPFLG		; Reset Disk?
	ORA	A
	JNZ	NOOPT
;
; Disk reset if R option entered on command line
;
	MVI	C,RESET
	CALL	CPM
;
; Validate drive code and user area numbers from the drive table
;
NOOPT:	LXI	D,DRUMSG	; Get drive/user error message
	PUSH	D
	LDA	FCB		; Get directory drive code
	DCR	A		; Normalize to range of 0-31
	CPI	HIDRV-LODRV	; Compare with max drives on-line
	JNC	ERXIT		; Drive error exit if out of range

	 IF	MAXDRV		; Look for MXDRV

	 IF	ZCPR33
	LHLD	Z3DRVL		; Point to ENV as loaded
	 ENDIF		;ZCPR33

	 IF	NOT ZCPR33
	LXI	H,MXDRV		; A(MXDRV) to HL
	 ENDIF		;NOT ZCPR33

	MOV	L,M		; (MXDRV) to L
	 ENDIF			; MAXDRV

	 IF	MAXDRV

	 IF	NOT ZCPR33
	INX	H		; +1
	 ENDIF		; NOT ZCPR33

	CMP	L		; Check it
	JNC	ERXIT		; Oops if not bigger
	 ENDIF			; MAXDRV
;
; Skips any drives marked 0FFh, some computers do not have contiguous
; drives, such as Heath H89, etc.
;
	MOV	E,A		; Drive code = table index
	MVI	D,0
	LXI	H,LODRV		; DUTBL Pointer
	DAD	D		; DUTBL Pointer+INDEX
	MOV	A,M		; User Number
	ORA	A		; Set Status
	JM	NDSK		; If negative, ignore drive

	 IF	WHEEL

	 IF	ZCPR33
	PUSH	H
	LHLD	Z3WHLL		; Point to enviorment
	MOV	A,M		; Get it
	POP	H
	 ENDIF		;ZCPR33

	 IF	NOT ZCPR33
	LDA	WHLOC		; Get wheel byte
	 ENDIF		;NOT ZCPR33

	ORA	A		; Check it
	JZ	USRCK		; If reset, restrict user
	MVI	A,MXZUSR	; If set, max user = MXZUSR
	JMP	USRCK1
	 ENDIF			; WHEEL

USRCK:	LXI	H,LODRV		; DUTBL PTR
	DAD	D		; DUTLB PTR+INDEX
	MOV	A,M		; Load max user for this drive

	 IF	MAXUR		; Use low memory values if smaller
	MOV	H,A		; Current value of MAXUSR

	 IF	ZCPR33
	PUSH	H
	LHLD	Z3USRL		; Point to ENV
	MOV	A,M		; Get user
	POP	H
	 ENDIF		;ZCPR33

	 IF	NOT ZCPR33
	LDA	MXUSR		; Alternate value
	 ENDIF		;NOT ZCPR33

	 ENDIF			; MAXUR

	 IF	( MAXUR AND NOT ZCPR3 ) AND NOT ZCPR33
	SBI	1		; MAXUSR is really maximum user+1
	 ENDIF			; MAXUR AND NOT ZCPR3 AND NOT ZCPR33

	 IF	MAXUR
	CMP	H		; Compare the two
	JNC	USRCK1		; OK if MAXU <= table value
	STA	MAXUSR		; Else replace it
	 ENDIF			; MAXUR

USRCK1:	MOV	B,A		; Save max user for later testing
	ANI	1FH		; Insure in range 0-31
	STA	MAXUSR		; Save it for later
	LXI	H,NEWUSR	; Point to directory user area
	CMP	M		; Compare with the maximum
	JC	ERXIT		; User number illegal, error exit
	POP	D		; Destroy error message pointer
	MOV	A,B		; Check to see if this drive
	ORA	A		; Has been mapped out
	JM	NDSK		; Yes, skip this drive
	LXI	H,FCB+1		; No, point to name
	MOV	A,M		; Any name specified?
	CPI	'$'		; Delimiter?
	JZ	WCD		; Yes, All files
	CPI	'/'		; Unix/ZCPR3 delimiter?
	JZ	WCD		; Yes, All files
	CPI	'['		; CP/M+ delimiter?
	JZ	WCD
	CPI	' '		; No, Filename specified
	JNZ	GOTFCB
;
; No FCB - make FCB all '?'
;
WCD:	MVI	B,11		; Filename+typ length

QLOOP:	MVI	M,'?'		; Store "?" in FCB
	INX	H		; FCB pointer+1
	DCR	B		; FCB length-1
	JNZ	QLOOP		; Continue

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		; Load drive code from FCB
	DCR	E		; Normalize drive code for select
	MVI	C,SELDSK	; Select directory drive to retrieve
	CALL	CPM		; The proper allocation vector
	CALL	CKVER		; Check version
	JC	V14		; Pre-2.x...get parameters the 1.4 way
	MVI	C,DSKPAR	; If 2.2 or MP/M...request DPB
	CALL	BDOS
	INX	H
	INX	H
	MOV	A,M		; Load block shift
	STA	BLKSHF		; Block Shift
	INX	H		; Bump to block mask
	MOV	A,M		; Load block mask
	STA	BLKMSK		; Block Mask
	INX	H
	INX	H
	MOV	E,M		; Get maximum block #
	INX	H
	MOV	D,M
	XCHG
	SHLD	BLKMAX		; Maximum Block #
	XCHG
	INX	H
	MOV	E,M		; Load directory size
	INX	H
	MOV	D,M
	XCHG
	JMP	FREE

V14:	LHLD	BDOS+1		; Get parameters 1.4 style
	MVI	L,3BH		; Point to directory size
	MOV	E,M		; Get it
	MVI	D,0		; Force high order to 0
	PUSH	D		; Save for later
	INX	H		; Point to block shift
	MOV	A,M		; Fetch
	STA	BLKSHF		; Save
	INX	H		; Point to block mask
	MOV	A,M		; Fetch it
	STA	BLKMSK		; And save it
	INX	H
	MOV	E,M		; Get maximum block #
	MVI	D,0
	XCHG
	SHLD	BLKMAX		; Save it
	POP	H		; Restore directory size
	JMP	FREE20		; Calculate free space from alloc vector
;
; Calculate number of K free on selected drive now so the FREE figure
; will not reflect either creation or additions to the DISK.DIR file.
; Note: This routine will not always function correctly as coded.  To
; insure the proper calculation when the $F option is specified and
; cataloging multiple disks on a single drive, you should do a CTL-C
; AFTER the disk to be cataloged has been readied.
;
FREE:	SHLD	DIRMAX		; Save max number of directory entries
	LDA	VERFLG		; Check version number
	CPI	30H		; CP/M 3.0?
	JC	FREE20		; No, Use old method
	LDA	FCB		; Load drive number
	DCR	A		; Normalize
	MOV	E,A		; Use compute free space BDOS call
	MVI	C,46		; Calculate free space
	CALL	CPM
	MVI	C,3		; Answer is a 24-bit integer

FRE3L1:	LXI	H,TBUF+2	; Answer in 1st 3 bytes of TBUF
	MVI	B,3		; Convert from records to k
	ORA	A		; By dividing by 8

FRE3L2:	MOV	A,M		; LS byte record count
	RAR			; /2
	MOV	M,A		; Replace
	DCX	H		; Next byte record count
	DCR	B		;
	JNZ	FRE3L2		; Loop for 3 bytes
	DCR	C
	JNZ	FRE3L1		; Shift 3 times
	LHLD	TBUF		; Now get result in k
	JMP	SAVFRE		; Save Free Space

FREE20:	MVI	C,DSKALL	; Allocation vector address
	CALL	BDOS
	XCHG
	LHLD	BLKMAX		; Max Block Number
	INX	H
	LXI	B,0		; Init block count = 0

GSPBYT:	PUSH	D		; Save allocation address
	LDAX	D
	MVI	E,8		; Set to process 8 blocks

GSPLUP:	RAL			; Test bit
	JC	NOTFRE
	INX	B

NOTFRE:	MOV	D,A		; Save bits
	DCX	H		; Count down blocks
	MOV	A,L
	ORA	H
	JZ	ENDALC		; Quit if out of blocks
	MOV	A,D		; Restore bits
	DCR	E		; Count down 8 bits
	JNZ	GSPLUP		; Do another bit
	POP	D		; Bump to next byte of allocation vector
	INX	D
	JMP	GSPBYT		; Process it

ENDALC:	POP	D		; Clear stack of allocation vector pointer
	MOV	L,C		; Copy blocks to HL
	MOV	H,B
	LDA	BLKSHF		; Load block shift factor
	SUI	3		; Convert from records to k
	JZ	SAVFRE		; Skip shifts if 1k blocks return free in HL

FREKLP:	DAD	H		; Multiply blocks by k/block
	DCR	A
	JNZ	FREKLP
;
SAVFRE:	SHLD	FREEBY		; Save free space for output later
	XCHG
	LHLD	TOTFRE
	DAD	D
	SHLD	TOTFRE
;
; Reenter here on subsequent passes while in the all-users mode
;
SETTBL:	LHLD	DIRMAX		; Load directory maximum size
	INX	H		; Directory size is DIRMAX+1
	DAD	H		; Double directory size
	LXI	D,ORDER		; Too get order table size
	DAD	D		; Allocate order table
	SHLD	TBLOC		; Name tbl begins where order tbl ends
	SHLD	NEXTT
	XCHG
	LHLD	BDOS+1		; Insure we have room to continue
	MOV	A,E
	SUB	L
	MOV	A,D
	SBB	H
	JNC	OUTMEM
	CALL	CKVER		; Set carry if pre-CP/M 2
	LDA	NEWUSR		; Load directory user area
	MOV	E,A
	MVI	C,STUSER	; Get the user function
	CNC	CPM		; Set new user number if CP/M 2
;
; Look up the FCB in the directory
;
	MVI	A,'?'		; Check for wild FCB extent
	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
	SHLD	TOTFIL		; "  total file counter
	SHLD	TOTSIZ		; "  total size counter
	CALL	SETSRC		; Set DMA for directory search
	MVI	C,SRCHF		; Load 'search first' function
	JMP	LOOK		; Go search for 1st match
;
; Read more directory entries
;
MORDIR:	MVI	C,SRCHN		; Search next function

LOOK:	LXI	D,FCB		; A(file control block)
	CALL	CPM		; Read directory entry
	INR	A		; End (0FFH)?
	JZ	SPRINT		; Yes, sort & print what we have
;
; Point to directory entry
;
	DCR	A		; Undo previous INR A
	ANI	3		; Make modulus 4
	ADD	A		; Multiply
	ADD	A		; By 32 because
	ADD	A		; Each directory
	ADD	A		; Entry is 32
	ADD	A		; Bytes long
	LXI	H,TBUF+1	; Point to buffer (skip to FN/FT)
	ADD	L		; Point to entry

	 IF	FATTRIB
	MOV	L,A		; HL now point to file name
	LDA	ONEFLG		; Looking for only attribute 1?
	ORA	A
	JNZ	NOTONE		; NZ=no
	MOV	A,M
	ORA	A
	JP	MORDIR		; P=not attr 1
NOTONE:	INX	H
	LDA	TWOFLG		; Only attribute 2?
	ORA	A
	JNZ	NOTTWO		; NZ=no
	MOV	A,M
	ORA	A
	JP	MORDIR		; P=not attr 2
NOTTWO:	INX	H
	LDA	THRFLG		; Only attrib 3?
	ORA	A
	JNZ	NOTTHR		; NZ=no
	MOV	A,M
	ORA	A
	JP	MORDIR		; P= not attr 3
NOTTHR:	INX	H
	LDA	FORFLG		; Only attr 4?
	ORA	A
	JNZ	NOTFOR		; NZ=no
	MOV	A,M
	ORA	A
	JP	MORDIR		; P= not attr 4
NOTFOR:	MOV	A,L
	ADI	5		; POINT TO R/O BYTE
	 ENDIF		; FATTRIB

	 IF	NOT FATTRIB
	ADI	8		; Point to R/O BYTE
	 ENDIF		; NOT FATTRIB

	MOV	L,A
	LDA	LOPFLG		; Should we allow R/O files?
	ORA	A
	JZ	QSYS		; Z=yes
	MOV	A,M		; Check for R/O
	ORA	A
	JM	MORDIR		; M=yes, ignore this file
QSYS:	INX	H
	LDA	QOPFLG		; Find only non-$ARC files?
	ORA	A
	JNZ	OSYS		; No, check for only $SYS files
	INX	H		; Yes, get the archive byte
	MOV	A,M
	DCX	H
	ORA	A		; Check bit 7 for $ARC file
	JM	MORDIR		; If set, ignore this filename

OSYS:	LDA	OOPFLG		; Find only $SYS files?
	ORA	A
	JNZ	CKSYS
	MOV	A,M		; Yes, get system byte
	ORA	A		; Check bit 7 for $SYS file
	JP	MORDIR		; If not set, ignore this filename
	JMP	SYSFOK		; Else check for a match

CKSYS:	LDA	SOPFLG		; Did user request $SYS files?
	ORA	A
	JZ	SYSFOK		; If yes, exit
	MOV	A,M		; Get system byte back
	ORA	A		; Check bit 7 for $SYS file
	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

	 IF	Z80DOS
	PUSH	B		;
	PUSH	D		;
	PUSH	H		;
	MVI	C,54		; Get time stamp from last search
	CALL	BDOS		;
	LXI	D,6		; Point to last access field
	LDA	DGOPFL
	ORA	A
	JZ	ACCESS		; Z=what is wanted
	LXI	D,2		; Point to last alteration field
	LDA	DAOPFL
	ORA	A
	JZ	ACCESS		; Z=what is wanted
	LXI	D,0		; Point to creation field
	LDA	DNOPFL
	ORA	A
	JZ	ACCESS		; Z=what is wanted

	LXI	D,2		; Didn't say, so give him alteration date

ACCESS: DAD	D		; Point to right field in returned database
	MOV	E,M		; Get the date in Julian
	INX	H
	MOV	D,M
	XCHG
	SHLD	DATMOD
;
	POP	H
	POP	D
	POP	B
	 ENDIF		;Z80DOS
;
; 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 OR REVID)
	ANI	7FH		; Remove attributes
	 ENDIF			; NOT (USELC OR REVID)

	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, oflo=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 oflo 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 has total extents
	MVI	B,7
	CALL	SHLL		; HL has total records less last ext
	INX	D		; DE->> S1
	INX	D		; DE->> S2
	INX	D		; Point to sector count
	LDAX	D		; Get it
	ADD	L
	MOV	L,A
	MOV	A,H
	ACI	0
	MOV	H,A		; HL 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

	 IF	Z80DOS
	LDA	DATMOD		; Get LSB of last modified date
	MOV	M,A		;
	INX	H		;
	LDA	DATMOD+1	; Get MSB of last modified date
	MOV	M,A		;
	INX	H		;
	 ENDIF		;Z80DOS

	SHLD	NEXTT		; Save updated table address
	XCHG
	LHLD	COUNT		; Bump the # of matches made
	INX	H
	SHLD	COUNT

	 IF	Z80DOS
	LXI	H,15		; Size of entry include date
	 ENDIF		;Z80DOS

	 IF	NOT Z80DOS
	LXI	H,13		; Size of next entry
	 ENDIF		;NOT Z80DOS

	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
;
; Shift HL left by B bits
;
SHLL:	DAD	H
	DCR	B
	RZ
	JMP	SHLL
;
; Sort and print
;
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

	 IF	Z80DOS
	LXI	B,15		; Entry length including date
	 ENDIF		;Z80DOS

	 IF	NOT Z80DOS
	LXI	B,13		; Entry length
	 ENDIF		;NOT Z80DOS

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 address, load loop counter
	DCX	H		; Count down loop
	MOV	A,L
	ORA	H		; More?
	XTHL			; Load table address, save loop 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	DONE		; Yes, so skip sort
;
; This sort routine is adapted from SOFTWARE TOOLS
;
	LHLD	SCOUNT		; Number of entries

L1:	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	DONE		; 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
	CALL	COMPARE		; Compare (J) and (JG)
	JP	L4		; 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	L4		; If J>0 go to l3
	ORA	L		; Check for zero
	JZ	L4
	JMP	L3

L4:	LHLD	SCOUNT		; For later
	XCHG
	LHLD	I		; I=I+1
	INX	H
	MOV	A,E		; If I<=n go to l2
	SUB	L
	MOV	A,D
	SBB	H
	JP	L2
	LHLD	GAP
	JMP	L1
;
; Sort is all done - print entries
;
DONE:
NOOUT:	LDA	FIRSTT		; First time through?
	ORA	A
	JNZ	NOVOPT		; No, we've been here before
	MVI	A,0FFH		; Yes,
	STA	FIRSTT		; Set first time flag
	LDA	VOPFLG		; Version display flag
	ORA	A		; Set?
	JNZ	NOVOPT		; No, skip version print
	LXI	D,VERNAME	; Yes, print version
	CALL	PUTS		; Print the string
	CALL	CRLF

NOVOPT:	LHLD	COUNT
	LXI	H,ORDER		; Initialize order table pointer
	SHLD	NEXTT
	LHLD	COUNT		; Code computes end of name table
	CALL	MULT13		; (or start of second table
	XCHG			; Where files to be stored after
	LHLD	TBLOC		; Redundant extents removed)
	DAD	D
	SHLD	NEWPTR		; Save it twice
	SHLD	XPOINT		; For later
;
; Output the directory files we've matched
;
ENTRY:	LHLD	COUNT		; Files matched count
	DCX	H		; Count-1
	SHLD	COUNT
	MOV	A,H		; Is this the last file?
	ORA	L
	JZ	OKPRNT		; Yes, last file so skip compare
;
; Compare each entry to make sure that it isn't part of a multiple
; extent file.	Go only when we have the last extent of the file.
;
	PUSH	B		; Save number of columns
	LHLD	NEXTT
	MVI	A,11
	CALL	COMPR		; Does this entry match next one?
	POP	B		; Restore number of columns
	JNZ	OKPRNT		; No, print it
NOKPRN:	INX	H
	INX	H		; Skip, highest extent last in list
	SHLD	NEXTT
	JMP	ENTRY		; Loop back for next lowest extent
;
; OKPRINT moves unique filenames and sizes in "k" to a second table
; above the first for use later.
;
OKPRNT:
;
	 IF	Z80DOS
	PUSH	H
	PUSH	D
	PUSH	B
	LHLD	NEXTT		; Get order table pointer
	MOV	E,M		; Get low order address
	INX	H
	MOV	D,M		; Get high order address
	LXI	H,13
	DAD	D
;	XCHG
	MOV	E,M
	INX	H
	MOV	D,M
	LHLD	DATCHK		; Get the date we are looking for
	MOV	A,H
	ORA	L
	JZ	GDTMTC		; Z=not looking
	MOV	A,H
	CMP	D		; Check if given date >,=,< the files date
	JZ	CHDLOW		; High EQ, check low
	JC	DATLT		; C=LT
	JMP	DATGE		; Given date GT file date
CHDLOW:	MOV	A,L		; Check low byte of date vs. file date
	CMP	E
DATGE:	MVI	A,0		; Assume EQ
	JC	DATLT		; C= given LT files date
	JZ	DATFLG		; Z= they are EQ
	MVI	A,2		; Given GT files date
	JMP	DATFLG
DATLT:	MVI	A,1		; Given was less than files
DATFLG:	STA	DTMTCH
	LDA	DEOPFL		; What kind of date match?
	ORA	A
	JZ	DTEXAC		; Z=exact
	LDA	DPOPFL
	ORA	A
	JZ	DTABVE		; Z=GE
	LDA	DMOPFL		; LT wanted?
	ORA	A
	JNZ	DTEXAC		; NZ=no, didn't tell us so do anything but gave
				; us a date so assume want exact match
	LDA	DTMTCH
	CPI	2
	JZ	GDTMTC		; Date was below and they wanted below
NDTMTC:
	POP	B
	POP	D
	POP	H
	PUSH	H
	LHLD	COUNT
	MOV	A,L
	ORA	H
	POP	H
	JZ	PRTOTL
	JMP	NOKPRN

DTEXAC:	LDA	DTMTCH		; They wanted exact, was it?
	ORA	A
	JZ	GDTMTC		; Z=yes
	JMP	NDTMTC
DTABVE:	LDA	DTMTCH		; They wanted GE
	CPI	1
	JZ	GDTMTC		; Z=G
	ORA	A
	JNZ	NDTMTC		; Must be 2, so not equal
GDTMTC:	POP	B
	POP	D
	POP	H
	 ENDIF		; Z80DOS
	
	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
	PUSH	H		; Save address of byte to be moved
	LHLD	NEWPTR		; Address in new table to put byte
	PUSH	H		; Save address

	 IF	Z80DOS
	LXI	D,15		; Update address including date
	 ENDIF		;Z80DOS

	 IF	NOT Z80DOS
	LXI	D,13		; Update address
	 ENDIF		;NOT Z80DOS

	DAD	D
	SHLD	NEWPTR		; Save for later (end of table)
	POP	H		; Set current move  to	address
	XCHG			; Swap pointers
	POP	H		; Set current move from address
	MVI	B,11		; Filename.typ length
	CALL	MOVE		; Move it

	 IF	Z80DOS
	PUSH	H
	 ENDIF		;Z80DOS

	PUSH	D
OKPR2:	
	CALL	SIZEFL
	LHLD	TOTSIZ		; DE = rounded size in K
	DAD	D		; Add to total used
	SHLD	TOTSIZ
	LHLD	TOTFIL		; Increment filecount
	INX	H
	SHLD	TOTFIL
	XCHG
OKPR3:
	POP	D		; A(size to go)
	MOV	A,H		; Move size to table two
	STAX	D
	INX	D
	MOV	A,L
	STAX	D

	 IF	Z80DOS
	POP	H		; Currently pointing to file size
	INX	H		; Skip size
	INX	H
	INX	D
	MOV	A,M		; Get LSB of date
	STAX	D		; Save it away
	INX	D
	INX	H
	MOV	A,M		; Ditto for MSB of date
	STAX	D
	 ENDIF		;Z80DOS
;
; One File Moved - Test to see if we have to move another
;
	LHLD	COUNT		; Current file counter
	MOV	A,H
	ORA	L
	JZ	PRTOTL		; Zero, output summary
	JMP	ENTRY
;.....
;
; 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.
;
SIZEFL:	MOV	D,M
	INX	H
	MOV	E,M		; Size in DE (records)
	XCHG
	SHLD	FILERC		; Save record count
	XCHG
	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
	MVI	B,3

SHRR:	MOV	A,D
	ORA	A
	RAR
	MOV	D,A
	MOV	A,E
	RAR
	MOV	E,A
	DCR	B
	JNZ	SHRR
	RET
;
; Print HL in decimal with leading zero suppression
;
DECPRT:	XRA	A		; Clear leading zero flag
	STA	LZFLG
	LXI	D,-10000
	LDA	SUPSPC
	PUSH	PSW
	XRA	A
	STA	SUPSPC
	CALL	DIGIT
	POP	PSW
	STA	SUPSPC
	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	PUTCHR

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	PUTCHR		; Print digit
	LDA	SUPSPC		; Get space suppression flag
	ORA	A		; See if printing file totals
	RZ			; Yes, don't give leading spaces
	JMP	SPACE		; Leading zero..print space
;
DIGNZ:	STA	LZFLG		; Leading zero flag set
	JMP	PUTCHR		; Print leading zero & digit
;.....
;
;-----------------------------------------------------------------------
;
;Multiply contents of HL register by 13
;
MULT13:	MOV	D,H
	MOV	E,L
	DAD	H
	DAD	D
	DAD	H
	DAD	H
	DAD	D

	 IF	Z80DOS
	DAD	D		; Actually by 15
	DAD	D		;
	 ENDIF	;Z80DOS

	RET
;.....
;
; Main subroutine to output a filename to be erased
;
VENTRY:
;.....
;
PFILE1:
	PUSH	H
	MVI	B,8		; Print filename and type
	CALL	PUTSB
	MVI	A,'.'
	CALL	PUTCHR
	MVI	B,3
	CALL	PUTSB
	
	 IF	Z80DOS
	LDA	NODFLG
	ORA	A
	JZ	NOD3
	CALL	DISDAT		; Display the date
NOD3:
	 ENDIF		;Z80DOS

	MOV	D,M		; Get it into DE
	INX	H
	MOV	E,M
	XCHG			; HL <-> DE
	SHLD	TFSIZE
	CALL	DECPRT		; Print it out
	LDA	FSIZEC		; Follow with 'k'
	CALL	PUTCHR
	POP	B		; B point to data base with file name
	PUSH	H
	LXI	H,OUTFCB	; Build an FCB with file name to erase
	LDA	FCB		; Get drive number
	MOV	M,A
	INX	H		; Point to name field of FCB
	MVI	E,0CH		; Copy 12 chars from data base to FCB
MOVFCB:
	LDAX	B
	MOV	M,A
	INX	H
	INX	B
	DCR	E
	JNZ	MOVFCB
	LDA	NOPFLG		; Are we in NO VERIFY?
	ORA	A
	JNZ	ERA0		; NZ= no
	CALL	CKABRT		; Yes, check for abort
	MVI	A,'Y'		; Force a YES answer to erase?
	JMP	ERA1
ERA0:	LXI	D,ERAMES	; Ask operator if should erase
	CALL	PUTS
	MVI	C,RDCON
	CALL	BDOS
ERA1:	ANI	5FH		; Convert to upper case
	PUSH	PSW
	CPI	3		; CTRL-C?
	JZ	ERAABO		; Z=yes, abort
	CPI	11		; CTRL-K
	JZ	ERAABO		; Z=yes, abort
	CPI	'Y'		; Y(es)?
	JNZ	NOERAS		; NZ=no, don't erase this one
	LDA	NEWUSR		; Set user are currently working on
	MOV	E,A		; And set it
	MVI	C,32
	CALL	5
	LDA	OUTFCB+9	; Change potential R/O to R/W
	ANI	7FH
	STA	OUTFCB+9
	LXI	D,OUTFCB
	MVI	C,1EH
	CALL	5		; And set file attributes
	LXI	D,OUTFCB
	MVI	C,13H
	CALL	5		; And go erase the file
	INR	A
	JNZ	OKERA		; NZ= no error
	LXI	D,ERAMSE	; Tell operator had a problem
	CALL	PUTS
	JMP	NOERAS
OKERA:
	LHLD	TFSIZE		; size of this file in 'K'
	XCHG
	LHLD	TOTSZ1		; Add i total so far
	DAD	D
	SHLD	TOTSZ1		; And save it away
	LHLD	TOTFL1
	INX	H
	SHLD	TOTFL1		; Up count of files done
	LXI	D,ERAMS1	; Say we did it fine
	CALL	PUTS
NOERAS:
	POP	PSW
	CALL	CRLF
	POP	H
	LHLD	TOTFIL		; Load number of files left
	DCX	H		; # files-1
	SHLD	TOTFIL		; Resave it
	RET			; This return
ERAABO:
	LXI	D,CKMS1		; Say ABORTED
	CALL	PUTS
	JMP	EX0		; And done

;.....
;
;		      End of routines
;-----------------------------------------------------------------------
;
; Show total space and files used
;
PRTOTL:	

PRTOT1:	XRA	A		; Get a zero to
	STA	SUPSPC		; Suppress leading spaces in totals
	LHLD	TOTFIL		; How many files matched?
	MOV	A,H
	ORA	L
	JZ	NXTUSR		; Skip summary if none found
	PUSH	H		; Save TOTFIL
	STA	FNDFLG		; Set file found flag
	LDA	SOHFLG
	ORA	A
	JZ	PRTOT2
	XRA	A
	STA	SOHFLG
	JMP	PRTOT3

PRTOT2: ;	CALL	CRLF

PRTOT3:	LXI	D,TOTMS1	; Print "13,10,' Drive'"
	CALL	PUTS
	LDA	FCB
	ADI	'A'-1
	CALL	PUTCHR		; Output the drive code
	CALL	CKVER
	JC	NOUSER
	CALL	PUTUSR		; Output user number

	 IF	NDIRS
	MVI	A,' '
	CALL	PUTCHR
	CALL	NAMDIR
	 ENDIF			; NDIRS

	LDA	USRNR
	CPI	10

	 IF	ULINE
	LXI	D,ULON		; Turn on underline
	CALL	COUTS		; If not null
	 ENDIF			; ULINE

NOUSER:
	POP	H		; Recall TOTFIL

	 IF	ULINE
	LXI	D,ULOFF		; Turn off underline
	CALL	COUTS		; If not null
	 ENDIF			; ULINE
	CALL	CRLF
;
; Summary line printed, now print detail files, first compute total
; printout lines.
;
NPRNT:

	MVI	A,1
	STA	SUPSPC		; Allow spaces preceding file sizes
	
;
; Fill a record with FF at the end of table 2
;
	LHLD	NEWPTR		; Now points to end of table 2
	MVI	B,128
	MVI	A,0FFH

NPRNT2:	MOV	M,A
	INX	H
	DCR	B
	JNZ	NPRNT2
;
; Increment the number of files for use later in VENTRY.  This insures
; that a column delimiter will be printed after the last filename, if
; the file appears in other than the last column of the display.
;
;	 IF	NOT Z80DOS
;	LXI	H,TOTFIL
;	INR	M
;	 ENDIF		;NOT Z80DOS
;
; Print first filename
;
NPRNT3:	LHLD	XPOINT		; XPOINT = to start of second table
	CALL	VENTRY		; At entry. Below, it is incremented
				; For additional lines of printout

NLINE:	LHLD	XPOINT		; Increment XPOINT to next file

	 IF	Z80DOS
	LXI	D,15
	 ENDIF		;Z80DOS

	 IF	NOT Z80DOS
	LXI	D,13
	 ENDIF		;NOT Z80DOS

	DAD	D
	SHLD	XPOINT
	LHLD	TOTFIL		; Out of files?
	MOV	A,H
	ORA	L
	JZ	NXTUSR		; Yes, Check for libraries
	JMP	NPRNT3
;
; Directory for one user area completed.  If all users option is select-
; ed, then go do another directory on the next user number until we ex-
; ceed the maximum user # for the selected drive.
;
NXTUSR:	LDA	AOPFLG		; All user flag
	ORA	A		; Set?
	JZ	NXTUSU		; Set if zero, show all user areas
	LDA	HOPFLG		; "H" flag to show remaining areas
	ORA	A
	JNZ	GOCLZ		; Non-zero, not set, exit

NXTUSU:	CALL	CKVER		; Running CP/M 2?
	JC	GOCLZ		; No, Skip user increment
	CALL	CKABRT		; Yes, Check for user abort
	LDA	MAXUSR		; No abort - get maximum user #
	LXI	H,NEWUSR	; Increment directory user number
	INR	M
	CMP	M		; Next user # exceed maximum?
	JNC	SETTBL		; No, more user areas to go
	LDA	BASUSR		; Reset base user number for
	MOV	M,A		; The next directory search
;
; We've finished all of our outputting. Flush the remainder of the out-
; put buffer and close the file before going to exit routine.
;
GOCLZ:
NXTDSK:	LXI	H,FNDFLG	; Load file found flag
	MOV	A,M
	MVI	M,0		; Clear found flag for next drive
	ORA	A
	JNZ	NDSK		; Continue if at least 1 file found
	LXI	D,NOFMS1	; Print 1st part of no files message
	CALL	PUTS		; Print it
	LXI	D,NOFLM
	CALL	PUTS		; Print message
	LDA	FCB
	ADI	'A'-1
	CALL	PUTCHR		; Output the drive
	CALL	CKVER
	JC	NOUSR1
	CALL	PUTUSR		; Output the user number

NOUSR1:	CALL	CRLF

NDSK:	LDA	DOPFLG		; Multi-disk selected?
	ORA	A
	JNZ	NPRT		; No, skip next check
	CALL	CKABRT		; Check for user abort
	MVI	A,HIDRV-LODRV	; Load max drive code to search
	LXI	H,FCB		; Increment directory FCB drive code
	INR	M
	CMP	M		; Does next disk exceed maximum?
	JC	NPRT

	 IF	MAXDRV

	 IF	ZCPR33
	PUSH	H
	LHLD	Z3DRVL		; Point to ENV
	MOV	A,M		; Get it
	POP	H
	 ENDIF		;ZCPR33

	 IF	NOT ZCPR33
	LDA	MXDRV		; Look at another value limit
	INR	A
	 ENDIF		;NOT ZCPR33

	CMP	M		; Is it lower?
	JC	NPRT		; Bail out if too low
	JMP	NOOPT		; Search next disk
	 ENDIF			; MAXDRV

	JNC	NOOPT		; Search next disk if maxdr not true
;
; If no printer, fall through to EXIT
;
NPRT:
	JMP	EXIT		; All done - exit to CCP
;.....
;
; Output the user number of the directory in decimal
;
PUTUSR:	LDA	NEWUSR
	CPI	10		; User no. < 10?
	JC	DUX		; Yes, skip 10's digit
	STA	USRNR
	PUSH	B		; No, process 10's digit
	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	PUTCHR
	MOV	A,B		; Recall units digit
	POP	B

DUX:	ADI	'0'		; Make it ASCII
	JMP	PUTCHR

;.....
;
; Force new line on output and check for page pause
;
CRLF:	MVI	A,13		; Send CR
	CALL	PUTCHR
	MVI	A,10		; Send LF
	JMP	PUTCHR
;.....

SPACE:	MVI	A,' '
;
; Output character in A to console, and optionally to printer
; and/or the output file.  Detects user abort request.
;
PUTCHR:	PUSH	B
	PUSH	D
	PUSH	H
	PUSH	PSW		; Save the character to output
	CALL	HITYPE		; Send it to console
	POP	PSW		; Restore the output character
	ANI	7FH		; Strip parity bit on character
;
; Test for erase mode no verify
;
	MOV	B,A		; Save stripped character to B
	CPI	10		; At end of line?
	JNZ	NOTEOL
	PUSH	PSW
	LDA	NOPFLG
	ORA	A
	JNZ	PAUSON
	LDA	LINCNT		; Load line count
	INR	A		; Bump it
	STA	LINCNT
	MVI	L,23		; Allows use of [more] to finish display
	CMP	L		; End of the screen?
	JC	PAUSON
	LXI	D,EOSMSG	; Else, display pause message
	MVI	C,PRINT		; Without checking for line feeds
	CALL	BDOS
	CALL	GETCH		; Wait for character
	CPI	'C'-40H		; Abort on CTL-C
	JZ	EXIT1
	CPI	'K'-40H		; Or CTL-K
	JZ	EXIT1
	CPI	'X'-40H		; Or CTL-X
	JZ	EXIT1
	CPI	' '		; See if printing character
	JC	NOTEOS		; Exit if not
	ANI	5FH		; Change to upper-case
	CPI	'C'		; Can abort with c, C
	JZ	EXIT1
	CPI	'K'		; Can abort with k, K
	JZ	EXIT1
	CPI	'X'		; Can abort with x, X
	JZ	EXIT1
NOTEOS:	XRA	A		; Reset line count
	STA	LINCNT
	LXI	D,MORERA	; Overwrite the [more] display
	MVI	C,PRINT
	CALL	BDOS
PAUSON:	POP	PSW
	CZ	CKABRT		; Check for user abort request
NOTEOL:	POP	H		; Exit from PUTCHR
	POP	D
	POP	B
	RET
;.....
;
; Fetch character from console (without echo)
;
GETCH:	LHLD	0000H+1		; Warm Boot Address
	MVI	L,9		; Direct Console
	CALL	GOHL		; Get Character
	ANI	7FH		; Strip off any parity
	RET

;.....
;
; Output character, with low-case or reverse-video highlighting if high
; bit set and conditionals enabled.
;
HITYPE:	DS	0

	 IF	USELC OR REVID
	ORA	A		; Check for attributes not set
	JP	CONOUT		; No attribute..ignore this one
	ANI	7FH		; Attribute set, delete now
	 ENDIF			; USELC OR REVID

	 IF	NOT USELCW AND WHEEL
	MOV	E,A		; Save the character for later

	 IF	ZCPR33
	PUSH	H
	LHLD	Z3WHLL		; Point to enviorment
	MOV	A,M		; Get it
	POP	H
	 ENDIF		;ZCPR33

	 IF	NOT ZCPR33
	LDA	WHLOC		; Get wheel byte
	 ENDIF		;NOT ZCPR33

	ORA	A		; Don't use lower case or REVID
	MOV	A,E		; Get back the character to display
	JZ	CONOUT
	 ENDIF			; NOT USELCW AND WHEEL

	 IF	REVID
	PUSH	PSW		; Save character
	LXI	D,RVON		; Turn on reverse video
	CALL	COUTS		; If not null
	POP	PSW		; Restore character
	 ENDIF			; REVID

	 IF	USELC
	CPI	'A'		; Change only from A-Z
	JC	TYPEC
	CPI	'Z'+1
	JNC	TYPEC		; Punctuation can change so leave it
	ORI	20H		; If attribute, make lower case
	 ENDIF			; USELC

	 IF	USELC OR REVID
TYPEC:	CALL	CONOUT		; Send the processed character
	 ENDIF			; USELC OR REVID

	 IF	REVID
	LXI	D,RVOFF		; Turn off reverse video
	CALL	COUTS		; If not null
	 ENDIF			; REVID

	 IF	USELC OR REVID
	RET
	 ENDIF			; USELC OR REVID
;.....
;
; Output character in A to console
;
CONOUT:	MOV	E,A		; Get character for BDOS entry
	MVI	C,WRCON
	JMP	BDOS		; Console Output
;.....
;
; Output (raw) null-terminated string at (DE) to console.
;

COUTS:	LDAX	D		; Get byte of string
	ORA	A		; Null?
	RZ			; Return if so
	PUSH	D
	CALL	CONOUT
	POP	D
	INX	D		; Next byte
	JMP	COUTS
;.....
;
; Output bytes at HL of length B to console/printer/file
;
PUTSB:	MOV	A,M
	CALL	PUTCHR
	INX	H
	DCR	B
	JNZ	PUTSB
	RET
;.....
;
; Output null-terminated string to console/printer/file
;
PUTS:	LDAX	D		; Load character from DE string
	ANI	7FH		; Strip off parity
	ORA	A		; Is a 0?
	RZ			; Yes, Terminate
	CALL	PUTCHR		; Display character
	INX	D		; Next string position
	JMP	PUTS		; Continue
;
; Check for a CTL-C or CTL-S entered from the keyboard.  Jump to EXIT if
; CTL-C, pause on CTL-S.
;
CKABRT:	PUSH	H
	PUSH	D
	PUSH	B
	MVI	C,CONST
	CALL	BDOS
	ORA	A
	JZ	CKAB3		; No character, exit
	MVI	C,RDCON
	CALL	BDOS
	ANI	5FH
	CPI	'S'-40H
	JZ	CKAB0
	CPI	'S'
	JNZ	CKAB1
	CALL	CKAB4

CKAB0:	MVI	C,RDCON
	CALL	BDOS
	ANI	5FH

CKAB1:	CPI	'C'-40H		; CTL-C?
	JZ	CKAB2		; Yes, quit
	CPI	'K'-40H
	JZ	CKAB2
	CPI	'X'-40H
	JZ	CKAB2
	CPI	' '		; Any other CTL-character, abort
	JC	CKAB3
	CALL	CKAB4		; Clear the character from screen
	CPI	'C'
	JZ	CKAB2
	CPI	'K'
	JZ	CKAB2
	CPI	'X'
	JNZ	CKAB3

CKAB2:	LXI	D,CKMS1
	CALL	PUTS
	POP	B
	POP	D
	POP	H
	JMP	EX0		; All done

CKAB3:	POP	B
	POP	D
	POP	H
	RET

CKAB4:	PUSH	PSW
	LXI	D,CKMS2
	CALL	PUTS
	POP	PSW
	RET
;.....
;
; Call here to call address in HL
;
GOHL:	PCHL
;
; Enter BDOS, save all extended registers
;
CPM:	PUSH	B		; Save Registers
	PUSH	D
	PUSH	H


	 IF	ZRDOS
	LDA	ZRDFLG		; ZRDOS running?
	ORA	A
	JNZ	ZRD		; ZRDOS error trap and DOSs call
	 ENDIF			; ZRDOS

	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		; Yes, was return code FF?
	JNZ	CPM20		; No, exit normally
	MOV	A,H		; Yes, check for error code
	ORA	A
	JNZ	DSKERR		; Exit if physical error
	MOV	A,B		; Else, continue normally

CPM20:	POP	H
	POP	D
	POP	B
	RET

;.....
;
; ZRDOS Error Trap and System Call exits to CPM20
;
	 IF	ZRDOS
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
;.....
;
; Set Warm Boot Trap in ZRDOS
;
SETTRAP:PUSH	H
	PUSH	D
	PUSH	B
	MVI	C,SETWBT	; Set warm boot trap to come here
	LXI	D,WBTRAP
	CALL	BDOS
	POP	B
	POP	D
	POP	H
	RET
;.....
;
; WBTRAP is where the ZRDOS returns control on warm boot (error)
;
WBTRAP:	LXI	H,DSKERR	; Return here after trap reset
	PUSH	H		; Save DSKERR on stack
;
; Reset Warm Boot Trap in ZRDOS
;
RESTRAP:PUSH	H
	PUSH	D
	PUSH	B
	PUSH	PSW
	MVI	C,RESWBT	; Reset warm boot trap
	CALL	BDOS
	POP	PSW
	POP	B
	POP	D
	POP	H
	RET
	 ENDIF			; ZRDOS


;.....
;
; For file output mode, return to old user area and set DMA for the file
; output buffer.
;
SETFOP:	CALL	CKVER		; Clear carry if CP/M 2 or later
	LDA	OLDUSR		; Get user number at startup
	MOV	E,A
	MVI	C,STUSER
	CNC	CPM		; Reset old user number if CP/M 2
	LXI	D,OUTBUF	; Move DMA from search buffer into
	JMP	SET2		; Output buffer
	RET
;.....
;
; Move disk buffer DMA to default buffer for directory search operations
; and BDOS media change routines (required for pre-CP/M 2 systems while
; in file output mode with active buffer).
;
SETSRC:	LXI	D,TBUF		; Default DMA Address

SET2:	MVI	C,STDMA		; Set DMA Address
	JMP	CPM
;.....
;
; Print amount of free space remaining on selected drive
;
PRTFRE:	LXI	D,TOTMS7	; Print " Free: '
	CALL	PUTS
	LHLD	FREEBY
	CALL	DECPRT		; Print k free
	LXI	D,TOTMS8	; Print "k "
	CALL	PUTS
	RET
;.....
;
; Show string on the console
;
SHOW:	LDAX	D		; Get character from DE string
	ANI	7FH		; Strip off parity
	ORA	A		; Is it a 0?
	RZ			; Yes, terminate
	PUSH	B		; Save registers
	PUSH	D
	PUSH	H
	CALL	CONOUT		; Show character on console
	POP	H		; Load registers
	POP	D
	POP	B
	INX	D		; Next string position
	JMP	SHOW		; Continue
;.....
;
; Compare routine for last extent of file search
;
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:	LDAX	B
	XRA	M		; Copy bit 7 of M
	ANI	7FH		; Into bit 7 of A
	XRA	M
	CMP	M		; Then compare
	INX	H
	INX	B
	JNZ	NOTEQL		; Quit on mismatch
	DCR	E		; Or end of count
	JNZ	CMPLP
;
NOTEQL:	POP	H
	RET			; Condition code tells all
;.....
;
; 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
;.....
;
; New compare routine for sorting
;
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,C
	MOV	D,B
	MOV	C,M
	INX	H
	MOV	H,M
	MOV	L,C
	MVI	B,13		; Count for normal sort
	LDA	TOPFLG		; Check for sort by type
	ORA	A
	JNZ	CMPLPE		; Jump if normal sort
	PUSH	H		; Save name pointers for later
	PUSH	D
	LXI	B,8		; Point to file types
	DAD	B
	XCHG
	DAD	B
	XCHG
	MVI	B,3		; Count for type compare
	CALL	CMPLPE
	POP	D		; Retrieve name pointers
	POP	H		;
	RNZ
	MVI	B,8		; Count for name compare
	CALL	CMPLPE
	RNZ
	INX	D		; Point to extent
	INX	D
	INX	D
	INX	H
	INX	H
	INX	H
	MVI	B,2		; Count for extent compare

CMPLPE:	LDAX	D		;
	XRA	M		; Copy bit 7 of M
	ANI	7FH		; Into bit 7 of A
	XRA	M		;
	CMP	M		; Then compare
	INX	D
	INX	H
	RNZ
	DCR	B
	JNZ	CMPLPE
	RET
;.....
;
; Error exit
;
ERXIT:
	CALL	CRLF		; Space down
	POP	D		; Load message string pointer
	CALL	PUTS		; Print message
	LXI	D,ERRMS1	; " Error"
	CALL	PUTS		; Print message
	CALL	CRLF		; Space down
;
; Exit - all done, restore stack
;
EXIT:	LDA	DOPFLG		; Multi-disk selected?
	ORA	A
	JNZ	EX0		; No, skip next
	CALL	CKABRT		; Check for user abort
	MVI	A,HIDRV-LODRV	; Maximum drive code to search
	LXI	H,FCB		; Increment directory FCB drive code
	INR	M
	CMP	M		; Does next disk exceed maximum?
	JC	EX0

	 IF	MAXDRV

	 IF	ZCPR33
	PUSH	H
	LHLD	Z3DRVL		; Point to ENV
	MOV	A,M		; Get it
	POP	H
	 ENDIF		;ZCPR33

	 IF	NOT ZCPR33
	LDA	MXDRV		; Look at another value limit
	INR	A
	 ENDIF		;NOT ZCPR33

	CMP	M		; Is it lower?
	JC	EX0		; Bail out if too low
	JMP	NOOPT		; Search next disk
	 ENDIF			; MAXDRV

	JNC	NOOPT		; Search next disk if MAXDR not true

EX0:
	CALL	CRLF
	MVI	C,CONST		; Check console status
	CALL	CPM
	ORA	A		; Character waiting?
	MVI	C,RDCON
	CNZ	CPM		; Gobble up character

	 IF	ZRDOS
	LDA	ZRDFLG		; ZRDOS running?
	ORA	A
	JNZ	EXIT2		; Yes
	 ENDIF			; ZRDOS

	LDA	VERFLG		; Version flag
	CPI	30H		; CP/M 3.0?
	JC	EXIT1		; No
	MVI	C,2DH		; Yes,
	MVI	E,0		; Reset error mode to default
	CALL	CPM
	JMP	EXIT2		; Quit

EXIT1:	LDA	DOPFLG		; If they were swapped
	ORA	A
	CZ	SWAPEM

EXIT2	EQU	$


	LDA	AOPFLG		; Doing all users
	MOV	C,A
	LDA	DOPFLG		; Or disk?
	ANA	C
	MOV	C,A
	LDA	HOPFLG		; Or higher users?
	ANA	C
	JNZ	TOTDONE		; If no, skip totals
	LXI	D,ALLTOT	; First part of message
	CALL	PUTS
	LHLD	TOTFL1		; Total files found
	CALL	DECPRT
	LXI	D,TOTMS4
	CALL	PUTS
	LHLD	TOTSZ1		; Total 'k' found
	CALL	DECPRT
	LXI	D,TOTMS8
	CALL	PUTS
	LXI	D,TOTMS7
	CALL	PUTS
	LHLD	TOTFRE
	XCHG
	LHLD	TOTSZ1
	DAD	D
	CALL	DECPRT
	LXI	D,ALLTO1
	CALL	PUTS
TOTDONE:
	 IF	WMBOOT
	JMP	0000H
	 ENDIF			; WMBOOT

	LDA	OLDDSK		; Restore original drive
	MOV	E,A
	MVI	C,14
	CALL	CPM
	LDA	OLDUSR		; Restore original user area
	MOV	E,A
	MVI	C,32
	CALL	CPM

EXIT3:	LHLD	STACK		; Get old stack pointer
	SPHL			; Move back to old stack
	RET			; And return to CCP
;.....
;
	 IF	NDIRS
NAMDIR:	MVI	A,0
	STA	CURDIR		; Initial check count

NAMDR1:	LHLD	NAMADR		; Named directory buffer address

NAMDR2:	LDA	FCB		; Get current Drive
	CMP	M		; Does NDR entry match current drive?
	JNZ	NXTDIR		; No, check next
	LDA	NEWUSR		; Get current user
	INX	H
	CMP	M		; Does NDR entry match current user?
	JNZ	NXTDIR		; No, check next
	MVI	A,'['		; Frame the name in brackets
	CALL	PUTCHR
	MVI	C,8		; Number of Characters in entry

DIRCHR:	INX	H		; Match, Point to Directory Name
	MOV	A,M		; Get Character
	CPI	20H		; End of entry?
	JNZ	DIRCH1		; No

DIRCH0:	PUSH	PSW
	MVI	A,']'		; Print closing bracket
	CALL	PUTCHR
	POP	PSW
	JMP	DIRCH2

DIRCH1:	CALL	PUTCHR
	DCR	C
	JNZ	DIRCHR		; Output Eight characters
	JMP	DIRCH0
	RET			; Done
DIRCH2:	MOV	A,C
	ORA	A
	RZ
	MVI	A,20H		; Fill with spaces for neatness sake
	CALL	PUTCHR
	DCR	C
	JNZ	DIRCH2
	RET

NXTDIR:	LDA	CURDIR
	ADI	1		; Increment Directory pointer
	STA	CURDIR
	LXI	H,NUMDIR
	CMP	M		; Exceeded Max Entry?
	JZ	NODIR		; Yes, there is no entry for this DU
	LHLD	NAMADR		; Get base NDR address
	MVI	D,0
	MVI	E,18		; Increment to next entry

NXTD:	DAD	D
	DCR	A		; Decrement count
	JNZ	NXTD		; Until current Offset reached
	JMP	NAMDR2		; And check the entry for a match
NODIR:	MVI	C,10		; No match, output ten spaces

NODIR1:	MVI	A,20H
	CALL	PUTCHR
	DCR	C
	JNZ	NODIR1
	RET
	 ENDIF			; NDIRS
;.....
;
; Trap BDOS select and sector error vectors to our own intercept routine
; so we can catch a reference to an illegal drive.
;
SWAPEM:	DS	0

	 IF	ZRDOS
	LDA	ZRDFLG		; See if ZRDOS running
	ORA	A
	RNZ			; Yes, quit this
	 ENDIF			; ZRDOS

	LDA	VERFLG		; Version flag
	CPI	30H		; Error mode call available?
	JC	SWAP20		; No, use BDOS error vectors
	MVI	C,2DH		; Yes, use error mode call
	MVI	E,0FFH		;
	CALL	CPM		; Set "return code only" mode
	RET

SWAP20:	LHLD	BDOS+1		; Load pointer to base of BDOS
	INX	H		; Swap new pointer if running a
	MOV	E,M		; Program below the CCP
	INX	H
	MOV	D,M
	XCHG			; HL points to the proper vector
	MVI	L,9		; Point to record error vector
	LXI	D,VECTBL	; Exchange with our vector table
	MVI	A,4		; 4 bytes to swap

SWAPLP:	MOV	B,M		; Load byte from HL
	XCHG
	MOV	C,M		; Load byte from DE
	MOV	M,B		; Save byte from HL
	XCHG
	MOV	M,C		; Save byte from DE
	INX	H		; Increment exchange pointers
	INX	D
	DCR	A		; Counter-1
	JNZ	SWAPLP		; Continue swapping
	RET
;.....
;
; Check CP/M version number. Return carry flag set if pre-CP/M 2.  If
; CP/M 2 or later or MP/M (any version), return carry clear.
;
CKVER:	LDA	VERFLG		; Version Flag
	CPI	20H		; CP/M 2.0?
	RET
;.....
;
; Return point from intercepted BDOS select and bad record errors.
;
DSKERR:	LXI	SP,STACK	; Get out of BDOS' stack
	JMP	EXIT		; And exit back to CCP
;.....
;
;-----------------------------------------------------------------------
;		     Start of FNAME routine
;
; Main module
;	on entry, DE points to FCB to be filled, HL points to first
;		byte of target string, RFCB is 36 bytes long
;	on exit, B=disk number (1 for A, etc.) and C=user number
;		HL points to terminating character
;		A=0 and Z set if error in disk or user numbers
;		A=0FFH and NZ if ok
;
MAXDISK	EQU	16		; Maximum number of disks
MAXUSER	EQU	31		; Maximum user number

FNAME:	PUSH	D		; Save DE
	MVI	A,0FFH		; Set default disk and user
	STA	DISKNO
	STA	USERNO
	MVI	B,36		; Initialize FCB
	PUSH	D		; Save pointer
	XRA	A		; A=0

FNINI:	STAX	D		; Store zero
	INX	D		; Point to next
	DCR	B		; Count down
	JNZ	FNINI
	POP	D		; Get pointer back
	PUSH	H		; Save pointer
;
; Scan for colon, comma, or space in string
;
COLON:	MOV	A,M		; Scan for colon or space
	INX	H		; Point to next
	CPI	':'		; Colon found?
	JZ	COLON1
	CPI	','		; Comma found?
	JZ	GETF1
	CPI	' '+1		; Delimiter?
	JC	GETF1
	JMP	COLON		; Continue if not EOL
;
COLON1:	POP	H		; Clear stack
	MOV	A,M		; Save possible drive specification
	CALL	CAPS		; Capitalize
	CPI	'A'		; Digit if less than "A"
	JC	USERCK		; Process user number
	SUI	'A'		; Change from ASCII to binary
	CPI	MAXDISK		; Within bounds?
	JC	SVDISK
;
ERREXIT:XRA	A		; Error indicator
	POP	D		; Restore DE
	RET
;.....
;
; Log in specified disk
;
SVDISK:	INR	A		; Adjust to 1 for "A"
	STA	DISKNO		; Save flag
	INX	H		; Point to next character
;
; Check for user
;
USERCK:	MOV	A,M		; Get possible user #
	CPI	':'		; No user number
	JZ	GETFILE
	CPI	'?'		; All user numbers?
	JNZ	USERC1
	STA	USERNO		; Set value
	INX	H		; Point to after
	MOV	A,M		; Must be colon
	CPI	':'
	JZ	GETFILE
	JMP	ERREXIT		; Fatal error if not colon after ?

USERC1:	XRA	A		; Zero user number
	MOV	B,A		; B = A for user number

USRLOOP:MOV	A,M		; Get digit
	INX	H		; Point to next
	CPI	':'		; Done?
	JZ	USRDN
	SUI	'0'		; Convert to binary
	JC	ERREXIT		; User number error?
	CPI	10
	JNC	ERREXIT
	MOV	C,A		; Next digit in C
	MOV	A,B		; Old number in A
	ADD	A		; *2
	ADD	A		; *4
	ADD	B		; *5
	ADD	A		; *10
	ADD	C		; *10+new digit
	MOV	B,A		; Result in B
	JMP	USRLOOP

USRDN:	MOV	A,B		; Get newer user number
	CPI	MAXUSER+1	; Within range?
	JNC	ERREXIT
	STA	USERNO		; Save in flag
	JMP	GETFILE
;
; Extract file name
;
GETF1:	POP	H		; Get pointer to byte
;
GETFILE:MOV	A,M		; Pointing to colon?
	CPI	':'
	JNZ	GFILE1
	INX	H		; Skip over colon

GFILE1:	MOV	A,M		; Get next character
	CPI	','		; Delimiter?
	JZ	GFQUES
	CPI	' '+1		; Not a delimiter?
	JNC	GFILE2

GFQUES:	INX	D		; Fill with ???
	MVI	B,11		; 11 bytes
	MVI	A,'?'

GFFILL:	STAX	D		; Put?
	INX	D		; Point to next
	DCR	B		; Count down
	JNZ	GFFILL

FNDONE:	LDA	DISKNO		; Get disk number
	MOV	B,A		; In 'B'
	LDA	USERNO		; Get user number
	MOV	C,A		; In 'C'
	POP	D		; Restore registers
	MVI	A,0FFH		; No error
	ORA	A		; Set flags
	RET
;
; Get file name fields
;
GFILE2:	MVI	B,8		; At most, 8 byte filename
	CALL	SCANF		; Scan and fill
	MVI	B,3		; At most, 3 byte filetype
	MOV	A,M		; Get delimiter
	CPI	'.'		; Filename ending in "."?
	JNZ	GFILE3
	INX	H		; Point to character after "."
	CALL	SCANF		; Scan and fill
	JMP	FNDONE		; Done, return to "args"

GFILE3:	CALL	SCANF4		; Fill with spaces
	JMP	FNDONE
;
; Scanner routine
;
SCANF:	CALL	DELCK		; Check for delimiter
	JZ	SCANF4		; Fill with spaces if found
	INX	D		; Next byte in filename
	CPI	'*'		; Question mark fill ?
	JNZ	SCANF1
	MVI	A,'?'		; Place "?"
	STAX	D
	JMP	SCANF2

SCANF1:	STAX	D		; Place character
	INX	H		; Next position

SCANF2:	DCR	B		; Count down
	JNZ	SCANF		; Continue loop

SCANF3:	CALL	DELCK		; Skip to delimiter
	RZ
	INX	H		; Point to next
	JMP	SCANF3

SCANF4:	INX	D		; Next filename or filetype
	MVI	A,' '		; Fill with spaces
	STAX	D
	DCR	B		; Count down
	JNZ	SCANF4
	RET
;.....
;
; Check character pointed to by HL for a delimiter,
; return with Zero flag set if the character is a delimiter
;
DELCK:	MOV	A,M		; Get the character
	CALL	CAPS		; Capitalize
	ORA	A		; 0=delimiter
	RZ
	CPI	' '+1		; Space character+1
	JC	DELCK1		; Space character or less
	CPI	'='
	RZ
	CPI	5FH		; Underscore
	RZ
	CPI	'.'
	RZ
	CPI	':'
	RZ
	CPI	';'
	RZ
	CPI	','
	RZ
	CPI	'<'
	RZ
	CPI	'>'
	RET
;
DELCK1:	CMP	M		; Compare with self for OK
	RET
;.....
;
CAPS:	CPI	'a'
	RC
	CPI	'z'+1
	RNC
	SUI	20H
	RET
;.....
;		      End of FNAME routine
;
;.....
;
; 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


;-----------------------------------------------------------------------
;			   help routine
;
; Help menu if ? is typed, using a fancy ZCMD or ZCPR system
;
;
; Help menu if ? is typed, NOT using any fancy ZCMD or ZCPR system
;
HELPME:	LXI	D,OPTMSG	; Point at message
	CALL	SHOW
	JMP	EXIT3		; And exit
;
OPTMSG:	DB	13,10,13,10
	DB	'  Available Options (start with a  $  or  /  or'
	DB	'  [  character):',13,10
	DB	13,10
	DB	'  A - all user areas               D - all drives',13,10
	DB	'  H - current area to highest      L - include $R/O files'
	DB	13,10
	DB	'  O - $SYS files only              Q - non $ARChived only'
	DB	13,10
	DB	'  R - reset disk system            S - include $SYS files'
	DB	13,10
	DB	'  T - order files by EXT type      V - show version'
	DB	13,10

	 IF Z80DOS
	DB	'  Z - do not show dates',13,10
	 ENDIF			; Z80DOS

	 IF	FATTRIB
	DB	'  1 - files with attrib 1          2 - files with attrib 2'
	DB	13,10
	DB	'  3 - files with attrib 3          4 - files with attrib 4'
	DB	13,10
	 ENDIF		;FATTRIB

	 IF	Z80DOS
	DB	'  = - Exact date match             + - GE date match',13,10
	DB	'  - - LT date match                ! - Use creation date for'
	DB	' match',13,10
	DB	'  % - Use alteration date match    @ - Use access date for'
	DB	' match',13,10
	DB	' A date input with no =+-!%@ will use =% default,'
	DB	' * as date is current date'
	DB	13,10,13,10
	DB	' Ex - to purge all drv/users of .BAK, no verify,'
	DB	' GE date match on access date:',13,10,13,10
	DB	'                     B0>SD *.BAK $AND+@ 7/1/88',13,10,13,10,0
	 ENDIF		;Z80DOS

	 IF	NOT Z80DOS
	DB	13,10,'  Example - to purge all drv/users of .BAK,'
	DB	' no verify:',13,10,13,10
	DB	'                     B0>SD *.BAK $AND <ret>'
	DB	13,10,13,10,13,10,13,10,13,10
	DB	0
	 ENDIF		;NOT Z80ODS

	 IF	Z80DOS
DISDAT:	PUSH	B
	PUSH	H		; Save pointer to size field
	PUSH	D
	INX	H		; and skip over size
	INX	H		;
	MOV	E,M		; Get JD in DE
	INX	H		;
	MOV	D,M		;
	XCHG			; to HL
	CALL	DATEHL		;
	PUSH	H		; Month and Year in L,H
	PUSH	PSW		; Day in A
	CALL	SPACE
	CALL	SPACE
	POP	PSW
	JNZ	DAYOK		; NZ = was a day there
	POP	H
	CALL	NODATE
	JMP	DNOTOK
DAYOK:	PUSH	PSW
	MOV	A,L		; Month out
	CALL	BCDOUT
	MVI	A,'/'
	CALL	PUTCHR
	POP	PSW
	CALL	BCDOUT		; Day out
	MVI	A,'/'
	CALL	PUTCHR
	POP	H
	MOV	A,H		; Year out
	CALL	BCDOUT
DNOTOK:	CALL	SPACE
	CALL	SPACE
	POP	D
	POP	H
	POP	B
	RET

NODATE:
	LXI	D,NODATM
	CALL	PUTS
	RET
NODATM:
	DB	'-- -- --',0

BCDOUT:
	PUSH	B		; Save
	MOV	B,A		; A holds BCD digits
	RAR
	RAR
	RAR
	RAR
	CALL	BCDOT1		; Output high order
	MOV	A,B
	CALL	BCDOT1		; And low order
	POP	B
	RET
BCDOT1:	ANI	0FH
	ADI	'0'
	CALL	PUTCHR
	RET


;
; DATEHL converts the value in HL to BCD year, month, day
;	 for use with Z80DOS time stamps.
;
;
; Inputs:	HL contains hex days since December 31, 1977
;
; Outputs:	H contains BCD 20th century year
;		L contains BCD month
;		A contains BCD day
;
;		Zero flag set (Z) and A=0 if invalid date (zero) detected,
;		Zero flag reset (NZ) and A=0ffh otherwise.

; Converted to 8080 from DATEHL by Carson Wilson who Adapted from B5C-CPM3.INS

DATEHL:
	MOV	A,H
	ORA	L		; Test blank date (zero)
	RZ			; Return Z and A=0 if so
	SHLD	DAYS		; Save initial value
	MVI	B,78		; Set years counter
LOOP:
	CALL	CKLEAP
	LXI	D,-365		; Set up for subtract
	JNZ	NOLPY		; Skip if no leap year
	DCX	D		; Set for leap year
NOLPY:
	DAD	D		; Subtract
	JNC	YDONE		; Continue if years done
	MOV	A,H
	ORA	L
	JZ	YDONE
	SHLD	DAYS		; Else save days count
	INR	B		; Increment years count
	JMP	LOOP		; And do again
;
; The years are now finished, the years count is in 'B' (HL is invalid)
;
YDONE:
	MOV	A,B
	CALL	BINBCD
	STA	YEARS		; save BCD year
;
	CALL	CKLEAP
	MVI	A,0E4H		; -28
	JNZ	FEBNO		; February not 29 days
	MVI	A,0E3H		; Leap year -29
FEBNO:
	STA	FEB		; Set february
	LHLD	DAYS		; Get days count
	LXI	D,MTABLE	; Point to months table
	MVI	B,0FFH		; Set up 'B' for subtract
	MVI	A,0		; Set a for # of months
MLOOP:
	PUSH	PSW
	LDAX	D		; Get month
	MOV	C,A		; Put in 'C' for subtract
	POP	PSW
	SHLD	DAYS		; save days count
	DAD	B		; Subtract
	INX	D		; Increment months counter
	INR	A
	JC	MLOOP		; Loop for next month

;
; The months are finished, days count is on stack.  First, calculate
; month.
;
MDONE:
	MOV	B,A		; Save months
	LHLD	DAYS
	MOV	A,H
	ORA	L
	JNZ	NZD
	DCX	D
	DCX	D
	LDAX	D
	CMA
	INR	A
	MOV	L,A
	DCR	B
NZD:
	MOV	A,L		; Retrieve binary day of month
	CALL	BINBCD		; Convert to BCD
	PUSH	PSW		; Save day in A
;
	MOV	A,B		; Retrieve the binary month
	CALL	BINBCD		; Convert binary month to BCD
	MOV	L,A		; Return month in L
;
	LDA	YEARS
	MOV	H,A		; Return year in H
;
	POP	PSW		; Restore day
	ORA	A		; Set NZ flag
	RET

;
; Support Routines:
;

;
; Check for leap years.
;
CKLEAP:
	MOV	A,B
	ANI	0FCH
	CMP	B
	RET
;
; Convert A to BCD & store back in A
;
BINBCD:
	ORA	A
	RZ
	PUSH	B
	MOV	B,A
	XRA	A
BINBCD1:
	ADI	1
	DAA
	DCR	B
	JNZ	BINBCD1
	POP	B
	RET
;
; Buffers:
;

;
; Months table
;
MTABLE:
	DB	0E1H			;January -31
FEB:
	db	0E4H 			;February -28
	db	0E1H,0E2H,0E1H,0E2H 	;Mar-Jun -31,-30,-31,-30
	db	0E1H,0E1H,0E2H		;Jul-Sep -31,-31,-30
	db	0E1H,0E2H,0E1H		;Oct-Dec -31,-30,-31

	 ENDIF	;Z80DOS



;
; Messages and Error statements
;
CKMS1:	DB	13,10,'++ ABORTED ++',0
CKMS2:	DB	8,' ',8,0
DRUMSG:	DB	'Drive/User',0

ERRMS1:	DB	' '
ERRMS2:	DB	'Error',0
ERRTAG:	DB	' ->',0
NOFLM:	DB	'>> No file(s) on ',0
NOFMS1:	DB	13,10,0
NOFMS2:	DB	'  ',0
NOFMS3:	DB	':  ',0
SOHFLG:	DB	0
TOTMS1:	DB	13,10,'Drive ',0
TOTMS4:	DB	'/',0
TOTMS5:	DB	'k  ',0
TOTMS6:	DB	' Files: ',0
TOTMS7:	DB	' Free: ',0
TOTMS8:	DB	'k ',0
ALLTOT:	DB	13,10,'             Total files erased: ',0
ALLTO1:	DB	'k',13,10,0
ERAMES:	DB	'  Erase (Y/N)? ',0
ERAMS1:	DB	'  Erased',0
ERAMSE:	DB	' ERROR, COULD NOT ERASE!!!',0
WHLERR:	DB	13,10,' SPP ?',13,10,0
EOSMSG:	DB	'[more] ','$'
MORERA:	DB	13,'        ',13,'$'

;
; Permanently initialized data area
;
VECTBL:	DW	DSKERR		; BDOS record error intercept vector
	DW	DSKERR		; BDOS select error intercept vector
;
; End of code that must be stored on disk in the .COM file
;
; Data area reinitialized by code when SD is run or rerun
;
DATA0	EQU	$		; Start of area to initialize

OTBL	EQU	$		; Mark start of option table
AOPFLG:	DS	1
DOPFLG:	DS	1
HOPFLG:	DS	1
NOPFLG:	DS	1
OOPFLG:	DS	1
QOPFLG:	DS	1
ROPFLG:	DS	1
SOPFLG:	DS	1
TOPFLG:	DS	1
VOPFLG:	DS	1
LOPFLG:	DS	1

	 IF	Z80DOS		;
DEOPFL:	DS	1
DPOPFL:	DS	1
DMOPFL:	DS	1
DNOPFL: DS	1
DAOPFL: DS	1
DGOPFL:	DS	1
NODFLG:	DS	1
	 ENDIF	;Z80DOS

	 IF	FATTRIB
ONEFLG:	DS	1
TWOFLG:	DS	1
THRFLG:	DS	1
FORFLG:	DS	1
	 ENDIF

OEND	EQU	$		; End of option table
;
; End of option lookup table
;
BUFPNT:	DS	2		; Next location in output buffer
BUFCNT:	DS	1		; Number of bytes left in output buffer
OUTFCB:	DS	1+8+3		; User number, filename, and filetype
;
; Beginning of area reinitialized to zero each time SD.COM is run
;
	DS	21		; Rest of DISK.DIR FCB
DISKNO:	DS	1		; Disk number
USERNO:	DS	1		; User number
DRVFLG:	DS	1		; D option check for prior drive specificaton
FNDFLG:	DS	1		; Files Matched Flag

FIRSTT:	DS	1		; First time flag for version number
;
; Uninitialized data area
;
BASUSR:	DS	1		; Copy of original directory user #
BLKMAX:	DS	2		; Highest block # on drive
BLKMSK:	DS	1		; Records/block - 1
BLKSHF:	DS	1		; Number shifts to mult by sec/blk
COUNT:	DS	2		; Entry count
DIRMAX:	DS	2		; Highest file # in directory
FILERC:	DS	2		; File size in records
FREEBY:	DS	2		; Number of k left on dir. drive
FSIZEC:	DS	1		; File size character ('k' or 'r')
GAP:	DS	2		; Sort routine storage
I:	DS	2		; Sort routine storage
J:	DS	2		; Sort routine storage
JG:	DS	2		; Sort routine storage
LZFLG:	DS	1		; 0 when printing leading zeros
MAXUSR:	DS	1		; Max user # for drive
NEWUSR:	DS	1		; User # selected by "$U" option
NEXTT:	DS	2		; Next table entry
OLDDSK:	DS	1		; Currently logged-in drive
OLDUSR:	DS	1		; User number upon invocation
SCOUNT:	DS	2		; # to sort
SUPSPC:	DS	1		; Leading space flag
TBLOC:	DS	2		; Start of name table
TOTFIL:	DS	2		; Total number of files
TOTSIZ:	DS	2		; Total size of all files
TOTFL1:	DS	2		; Total files of all D/U
TOTSZ1:	DS	2		; Total size of all D/U
TFSIZE:	DS	2		; Size of file currently erased
TOTFRE:	DS	2
USRNR:	DS	1		; User number
VERFLG:	DS	1		; CP/M version number (0=pre-CP/M 2)
ZRDFLG:	DS	1		; ZRDOS version number

	IF	Z80DOS		;
DATCHK:	DS	2		; Holds date to look for
DTMTCH:	DS	1		; Holds <,>=,>
DATMOD:	DS	2		; Holds date found for file
DAYS:	ds	2		; temporary buffers
YEARS:	ds	1		;
YEARS1:	DS	1
MONTHS:	DS	1
DAYS1:	DS	1
ASCII:	DS	5		; holds date from system
	ENDIF		;Z80DOS


DATA1	EQU	$		; End of area to initialize
LINCNT:	DS	1
	 IF	ZCPR33
Z3DRVL:	DS	2		; Points to Z33 max drv location
Z3USRL:	DS	2		; Points to Z33 max user location
Z3WHLL:	DS	2		; Points to Z33 wheel location
	 ENDIF		;ZCPR33

	 IF	NDIRS
NAMADR:	DS	2		; Named Directory Buffer Address
NUMDIR:	DS	1		; Number of entries
CURDIR:	DS	1		; NDR Check counter
	 ENDIF			; NDIRS

NEWPTR:	DS	2		; Start of second table
XPOINT:	DS	2
OUTBUF:	DS	128		; Output file buffer
;
; BDOS equates
;
BDOS	EQU	0005H		; Entry Point for BDOS calls
FCB	EQU	005CH		; Default FCB Address
TBUF	EQU	0080H		; Default DMA Address

RDCON	EQU	1		; Console input
WRCON	EQU	2		; Console output
LIST	EQU	5		; List output
PRINT	EQU	9		; Print string
CONST	EQU	11		; Get console status
CPMVER	EQU	12		; Return CP/M version
RESET	EQU	13		; Reset disk system
SELDSK	EQU	14		; Select disk
OPEN	EQU	15		; Open file
CLOSE	EQU	16		; Close file
SRCHF	EQU	17		; Search for first
SRCHN	EQU	18		; Search for next
READ	EQU	20		; Read sequential
WRITE	EQU	21		; Write sequential
MAKE	EQU	22		; Make file
CURDSK	EQU	25		; Return current disk
STDMA	EQU	26		; Set DMA Address
DSKALL	EQU	27		; Get address of allocation vector
DSKPAR	EQU	31		; Get address of disk parameters
STUSER	EQU	32		; Set/get user number

	 IF	ZRDOS
ZRDVER	EQU	48		; Return version (ZRDOS)
SETWBT	EQU	50		; Set warm boot trap (ZRDOS)
RESWBT	EQU	52		; Reset warm boot trap (ZRDOS)
	 ENDIF			; ZRDOS

	DS	60		; Stack area
STACK:	DS	2		; Old stack pointer

ORDER	EQU	$		; Order table starts here

	END