; D.ASM v3.1  -  05/05/84
;
;		RESTRICTED DIRECTORY LIST PROGRAM
;
; D.COM is a directory list program, which writes 4 or 5 entries on a
; line, separated by colons.
;
;
;   (THIS IS THE 'WHATSNEW' PROGRAM SEEN ON MANY RCPM SYSTEMS)
;
;
; The command contains an internal table of file names, which are not to
; be shown when just "D" is typed.  (NOTE typing "D *.*" always shows
; all files)
;
; Why is this useful:  A typical CP/M disk contains many utility files,
; such as ED.COM, ASM,COM, PIP.COM, STAT.COM, etc.  When you do a direc-
; tory listing, you typically are not interested in seeing all those
; files, but rather just the "current" or "active" files.  This is what
; "D.COM" can do.
;
; NOTE: Direct CBIOS calls are used for input and output in order to
;	avoid echoing of inputted characters.  This keeps a noisy phone
;	line from causing garbage characters in the display.
;-----------------------------------------------------------------------
;
; 05/05/84  Line with the "use FILE xxx*.*" now only appears on the line
;   v3.1    with the message about moved or deleted files.
;					- Irv Hoff
;	
; 05/01/84  Changed the "Deleted files since --- " to "Files moved else-
;   v3.0    where or deleted", then added a line "use FILE xxx*.* to see
;	    if available."  With 20-40 megabyte disk systems now common,
;	    this is a convenient way to locate files which are no longer
;	    in the "Whatsnew" user area.  It was misleading when reading
;	    the files had been deleted when most have merely been moved.
;	    (Every SYSOP needs FILE.COM on his system.)  SD xxx*.* $U0AD
;	    may also be used, but gives information that is superfluous.
;	    Standardized the format.	- Irv Hoff
;
; 08/12/82  Added SUB file option to allow writing each new filename
;   v2.9    that appears in the "New Files" display to a .SUB file of
;	    the form:
;			XSUB
;			PIP
;			$1=$2 Fn.Ft$3
;			$1=$2 Fn.Ft$3
;
;	    etc., to allow a simple archive of new files to be performed
;	    by: SUBMIT D A:=B: [G1].  Also repaired bug in EXIT routine
;	    and removed character 'gobbler' routine so that the program
;	    will work better with 'type-ahead' BIOSes.
;					- Dave Hardy
;
; 11/23/78  Originally written by Ward Christensen.
;
;=======================================================================
;
; Use:	D *.*	prints all names, 5 across.
;
;	D *.ASM prints selected files just like DIR.
;
;	D SET builds a table (in D.COM) of all names currently on the
;		disk. (see *NOTE).
;
;	D SET <DATE>  adds the date for printing whenever is called by
;		'A>D<CR>' with no options.  If the date field is left
;		blank, it will be ignored.  Note that the date must be
;		8 characters or less (see *NOTE).
;
;	D TIT <TITLE FOR DISK> sets an internal disk title which prints
;		out each time the program is run (if a title has been
;		set).  (maximum of about 70 characters, please, although
;		it will handle a full CP/M input line.
;
;		NOTE: To get rid of title (and accompanying
;		print put type 'D TIT' and the title is
;		set to null.
;
;	D ADD FN.FT adds a name to the table in D.COM, so FN.FT will not
;		be listed by the 'D' command (see *NOTE).
;
;	D DEL FN.FT deletes a name from the table in D.COM, so if FN.FT
;		is in the directory, it will be listed by 'D' (see NOTE)
;
;	D SUB causes a file named 'D.SUB' to be generated on the current-
;		ly logged-in drive.  The file contains all of the 'New
;		Files' names, and is of the form:
;
;			XSUB
;			PIP
;			$1<fn1.ft>$2
;			$1<fn2.ft>$2
;			$1<fn3.ft>$2
;
;		etc.  D.SUB can be used to archive 'New Files' with a
;		simple command line like:  SUBMIT D B:=A: [G5] which
;		would PIP all of the new files from B5: to A:
;
;	D     lists the directory, showing only those files NOT in D.COM
;		as put there by 'D SET' or 'D ADD FN.FT'
;
;			*NOTE:	the program must write itself
;				back to disk, modified, so your
;				disk must not be write protected.
;
;-----------------------------------------------------------------------
;
;		Examples:  Suppose your disk has:
;
;	D.COM	  \
;	ASM.COM    \
;	ED.COM	    on it initially.
;	LOAD.COM   /
;	DDT.COM   /
;
;		You would type:  D SET to set these names into the
;		D.COM program.
;
;		Typing "D" would then list:
;
;	-->New files
;	A: ++ NONE ++
;
;	-->Deleted files
;	A: ++ NONE ++
;
;		Suppose you:  A>ED TEST.ASM, A>ASM TEST and LOAD TEST.
;		Typing D would then list:
;
;	-->New files
;	A: TEST    ASM : TEST	 BAK : TEST    HEX : TEST    COM
;
;	-->Deleted files
;	A: ++ NONE ++
;
;		i.e., it tells you of the "current" files on the disk.
;		Now, supposing you wanted to add TEST.COM as a "regular"
;		file on your disk.  Type:
;
;	D ADD TEST.COM
;
;		Now, typing D will show:
;
;	-->New files
;	A: TEST    ASM : TEST	 BAK : TEST    HEX
;
;	-->Deleted files
;	A: ++NONE++
;
;		i.e., TEST.COM is now considered a "permanent" file.
;
;		Now, suppose you accidentally erased ASM.COM from your
;		disk.  Typing D gives:
;
;	-->New files
;	A: TEST    ASM : TEST	 BAK : TEST    HEX
;
;	-->Deleted files
;	A: ASM	   COM
;
;		showing you are missing one of the "regular" files.  If,
;		in fact, you didn't want ASM.COM to be on the disk, type:
;
;	D DEL ASM.COM
;
;		which will delete the name from the D.COM table, so
;		ASM.COM will not up as "deleted".
;
;=======================================================================
;
;	       SPECIAL NOTES FOR REMOTE SYSTEM USE:
;
; If you keep a dedicated copy of this program on each drive of your re-
; mote system, you can 'dedicate' each copy of this program to a drive
; by filling in the byte at 103H with the drive number.  This prevents
; such things as:
;
;	A>D B:
;		or
;	B>A:D
;
; Do this by using the command:
;
;	A>D LOK A:	to lock to a drive
;		or
;	A>D LOK 	to unlock
;
; If the conditional 'NOSYS' is set YES, $SYS files in CP/M 2.x will be
; ignored in both directory listings and when the "ADD" option is in-
; voked, unless the override char is specified.  This allows D.COM to be
; used as a "WHAT'S NEW" program for remote CP/M systems, where the $SYS
; files must not be listed.
;
; Examples:
;
;	A>D *.* S	 displays everything
;	A>D SET S	 puts ALL files in table
;	A>D SET 12/23/80 sets date for reference
;
;	    (if you use 'D SET S', you lose the date option..
;
; If you use this program on a remote system, you will likely want to
; change the commands (ADD, DEL, and SET) for security.  You will also
; want to change the $SYS suppress override character.	You may also
; want to change the name of the program to make the name itself more
; informative, e.g. "D.COM".
;
;
; -->IMPORTANT: If you want the program to be 'TAG'ed after every D SET
;		(so it cannot be taken by XMODEM), see the note at label
;		"WRBACK" for setting the F1 bit in the filename itself.
;
;
; Note that this program defines its own name for write-back purposes
; under the label "WRBACK".
;
;=======================================================================
;
; Define some stuff
;
YES:	EQU	0FFH
NO:	EQU	0
;
;
BIAS:	EQU	0		;for std cp/m or 4200h for altcpm
BDOS:	EQU	5+BIAS		;cp/m's BDOS access jump
CPMBUFF:EQU	80H+BIAS	;cp/m command line buffer
CR:	EQU	0DH		;carriage return
FCB:	EQU	5CH+BIAS	;cp/m's file control block
FCBRNO:	EQU	FCB+32		;rec # in fcb
LF:	EQU	0AH		;line feed
;
;
; Set the following for your system:
;
NOSYS	EQU	YES		;yes=ignore $sys files
FENCE	EQU	':'		;file name separator
NPL	EQU	4		;file names per line
;
;
; The leader string for the SUB file (XSUB, PIP) is located at label
; SUBF4.
;
;
	ORG	100H+BIAS
;
;
DENTRY:	JMP	AROUND
;
DRIVE:	DB	0		;<---drv # is put here if dedicated
				;(this can be done with the lok command)
;
;Initialize the local stack
;
AROUND:	LXI	H,0		;hl=0
	DAD	SP		;hl=stack
	SHLD	STACK		;save stack pointer
	LXI	SP,STACK	;init local stack
;
;
;Initialize direct CBIOS calls
;
	LHLD	1+BIAS
	LXI	D,3
	DAD	D		;hl=constat
	SHLD	TYPES+1
	DAD	D		;hl=conin
	SHLD	CIC+1
	DAD	D		;hl=conout
	SHLD	TYPEC+1
;
;
; Print ID message
;
	CALL	ILPRT		;print:
	DB	'D v3.1',CR,LF
	DB	'CTL-S pauses, CTL-C aborts',CR,LF,0
;
;
; Print Disk Title
;
PTITL:	LXI	H,DTITLE	;get title address
	MOV	A,M		;load it
	ORA	A		;end of string
	JZ	CONT		;don't print title
	CALL	ILPRT		;print heading
	DB	'Title: ',0
	LXI	H,DTITLE	;load it again
;
LOOP1:	MOV	A,M
	ORA	A		;zero?
	JZ	ENDPRT		;all done
	CALL	TYPE		;type this char
	INX	H		;next char
	JMP	LOOP1		;repeat ...

DTITLE:	DB	0		;storage for
	DS	7FH		;title
;
ENDPRT:	CALL	CRLF
;
;
; Set file control block
;
CONT:	LDA	DRIVE
	ORA	A		;non-dedicated?
	JZ	NOND		;jump if so
	STA	FCB
;
NOND:	LHLD	FCB+17		;get $sys override characters
	SHLD	SYSTOO		;and save for later
	LDA	FCB+19
	STA	SYSTOO+2
;
;
; See if request to add name to list
;
	LXI	H,FCB+1
	CALL	ADDCM2
;
ADDCM:	DB	'ADD        '	;11 characters (padded with spaces)
;
ADDCM2:	POP	D		;make de point to add command
	LXI	B,ADDCM2-ADDCM	;bc gets length of string
	CALL	COMPR
	JNZ	NOADD
;
;
; Got request to add name to table
;
	CALL	DELNAM		;first, delete the name
	CALL	FINDFF		;find end of table
	XCHG			;addr to de
;
;
; Move name to table
;
	LXI	H,FCB+17
	LXI	B,11
	CALL	MOVER
	MVI	A,0FFH
	STAX	D		;set new end
	JMP	WRBACK		;write program back
;
;
; See if request to add title to disk
;
NOADD:	LXI	H,FCB+1
	CALL	NOADD1A
NOADD1B:
	DB	'TIT'		;total of this and the next line must..
TITLEN:	DB	'        '	;be 11, change for a longer title name
;
NOADD1A:
	POP	D		;get to
	LXI	B,NOADD1A-NOADD1B
	CALL	COMPR
	JNZ	NOADD2A
;
;
; Process the title or erase it, if none given
;
	LXI	H,CPMBUFF	;get length
	MOV	A,M		;move it to a
	SUI	TITLEN-NOADD1B+1;but don't include the title command
	JZ	TITNO		;no title?
	LXI	H,CPMBUFF+TITLEN-NOADD1B+2
	LXI	B,0000
	MOV	C,A		;put length in bc
	LXI	D,DTITLE	;place to store
	CALL	MOVER		;move title in storage
	MVI	A,00		;and mark end
	STAX	D		;of string
	JMP	WRBACK		;and write back to disk
;...
;
;	
; No title - Clear title
;
TITNO:	LXI	H,DTITLE	;load in space
	MVI	M,00		;store end of string
	JMP	WRBACK		;and write back to disk
;.....
;
;
; See if request to lock D.COM to a drive
;
NOADD2A:
	LXI	H,FCB+1
	CALL	NOADD3
;
NOADD2:	DB	'LOK        '
;
NOADD3:	POP	D		;get to
	LXI	B,NOADD3-NOADD2
	CALL	COMPR
	JNZ	NOLOK
;
;
; Got request to lock
;
	LDA	FCB+16
	STA	DRIVE
	STA	FCB
	JMP	WRBACK
;.....
;
;
; See if request to DEL name from list
;
NOLOK:	LXI	H,FCB+1
	CALL	NOLOK3
NOLOK2:	DB	'DEL        '	;must be 11 total
;
NOLOK3:	POP	D		;get to
	LXI	B,NOLOK3-NOLOK2
	CALL	COMPR
	JNZ	NODEL
;
;
; Got request to delete a name from the file
;
	CALL	DELNAM		;delete the name
	JNC	WRBACK		;write back if ok
	CALL	MSGXIT
	DB	'++ NAME NOT IN TABLE ++$'
;.....
;
;
; See if request is to make SUB file
;
NODEL:	LXI	H,FCB+1
	CALL	SUBF3
SUBF2:	DB	'SUB        '	;must be 11 total
;
SUBF3:	POP	D
	LXI	B,SUBF3-SUBF2
	CALL	COMPR
	JNZ	NOSUB
;
;
; Got request to make SUB file, so say so, and set flag to force it
;
	CALL	SAYSUB		;tell console that sub file will be made
	DB	'Writing SUBMIT file...',CR,LF,'$'
;
SAYSUB:	POP	D
	MVI	C,9
	CALL	BDOS
	MVI	A,0FFH		;tell prgm to make sub file
	STA	SUBFLG
	LXI	H,SUBBUF	;write sub file start into file buffer
	CALL	SUBF5		;(xsub, pip, etc.)
;
SUBF4:	DB	'XSUB',CR,LF,'PIP',CR,LF
;
SUBF5:	POP	D		;use mover routine to copy to sub buffer
	XCHG
	LXI	B,SUBF5-SUBF4
	CALL	MOVER
	XCHG
	SHLD	SUBPTR		;save sub file buffer pointer
	LXI	H,FCB+1		;then fill tail in with spaces to make
	MVI	C,11		;  program think that no options chosen
;
NXSPC:	MVI	M,' '
	DCR	C
	INX	H
	JNZ	NXSPC
	MVI	C,36H		;initialize local fcb
	LXI	H,LFCB		;(no default, because commands there)
;
NXFCB:	MVI	M,0
	DCR	C
	INX	H
	JNZ	NXFCB
	LXI	D,LFCB+1	;set up local fcb to write d.sub file
	CALL	UWR2
;
UWR1:	DB	'D       SUB',0
;
UWR2:	POP	H
	LXI	B,UWR2-UWR1
	CALL	MOVER
	MVI	C,ERASE		;erase old file, if it exists
	LXI	D,LFCB
	CALL	BDOS
	XRA	A
	STA	LFCB		;set up to write to default drive
	STA	FCBRNO		;initialize record number
	MVI	C,MAKE		;create the file
	LXI	D,LFCB
	CALL	BDOS
	JMP	NOSET		;then jump off to display names as usual
;.....
;
;
; See if request to set up table from directory
;
NOSUB:	LXI	H,FCB+1
	CALL	NODEL3
NODEL2:	DB	'SET        '	;must total 11
;
NODEL3:	POP	D		;get to
	LXI	B,NODEL3-NODEL2
	CALL	COMPR
	JNZ	NOSET
;
;
; Got request to setup table.  Move the date (may be blank).
;
	LXI	H,FCB+17
	LXI	D,DATE
	LXI	B,8
	CALL	MOVER
;
	LXI	H,FCB+17
	LXI	D,DATE1
	LXI	B,8
	CALL	MOVER
;
	MVI	A,1		;turn on..
	STA	SETFLG		;..set flag
	MVI	A,0FFH		;clear..
	STA	NAMES		;..names table
	CALL	FILLQ		;make fcb '????????.???'
;
NOSET:	LDA	FCB+1		;get prtflg
	SUI	' '
	STA	PRTFLG
	PUSH	PSW
	CZ	HEAD1
	POP	PSW
	JNZ	GOTNAM
	CALL	FILLQ		;make name ????????.???
;
GOTNAM:	LDA	FCB
	ORA	A
	JZ	NODISK
	DCR	A
	MOV	E,A
	MVI	C,SELDSK
	CALL	BDOS
;
NODISK:	MVI	B,NPL		;names per line
	CALL	LINMRK
	MVI	C,SRCHF
	JMP	CALLIT
;
LINE:	MVI	B,NPL		;names per line
	CALL	LINMRK
;
NEXT:	MVI	C,SRCHN
;
CALLIT:	PUSH	B
	LXI	D,FCB
	CALL	BDOS
	INR	A
	JZ	CKNONE
	DCR	A
	ANI	3
	MOV	L,A
	MVI	H,0
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	LXI	D,81H+BIAS
	DAD	D
;
;
; Check for $SYS attribute, then clear all attributes
;
	PUSH	H
	LXI	D,9		;sys att offset
	DAD	D
	MOV	A,M
	ANI	80H
	STA	SYSFLG
	POP	H		;retrieve filename ptr
	PUSH	H
	MVI	E,11		;11 chars in filename
;
ATTLP:	MOV	A,M		;pick up char
	ANI	7FH		;kill attribute
	MOV	M,A		;put back down
	INX	H
	DCR	E
	JNZ	ATTLP
	POP	H
;
;
; See if name is to be printed
;
	XCHG			;name pointer to de
	LDA	SETFLG		;request to setup table?
	ORA	A
	JNZ	SETUP		;go set entry into table
	LDA	PRTFLG
	ORA	A
	JNZ	GOPRNT		;explicit request for all
	PUSH	D
	LXI	H,NAMES
;
CKNEXT:	POP	D		;get name pointer
	POP	B
	PUSH	B
	MOV	A,M		;end of table?
	INR	A		;was it 0ffh?
	JZ	GOPRNT
	MVI	B,0
	MVI	C,11		;name length
	PUSH	D
;
CKLP:	LDAX	D
	CMP	M
	JNZ	NOMACH
	INX	D
	INX	H
	DCR	C
	JNZ	CKLP		;loop for 11 chars
;
;
; Got match, mark it found but do not print it
;
	LXI	D,-11		;point back to name
	DAD	D
	MVI	M,0		;mark it found
	POP	D		;pop pointer
	POP	B
	JMP	NEXT		;skip the name
;
;
; Name didn't match, try next
;
NOMACH:	DAD	B		;point to next name
	JMP	CKNEXT
;
;
; Print the name
;
GOPRNT:
	 IF	NOSYS
	CALL	SYSCK
	JZ	DONAME
	LDA	SYSFLG
	RAL
	POP	B
	JC	NEXT
	PUSH	B
	 ENDIF			;NOSYS
;
;
DONAME:	LDA	SUBFLG		;see if sub file is to be made
	ORA	A
	CNZ	NAMSUB		;write the name into the sub buffer
	MVI	A,1		;say we got one
	STA	GOTFLG
	MVI	C,8
	XCHG			;name back to hl
	CALL	TYPMEM
	MVI	A,'.'
	CALL	TYPE
	MVI	C,3
	CALL	TYPMEM
	POP	B
	CALL	SPACE
	MVI	A,FENCE
	DCR	B
	PUSH	PSW
	CNZ	TYPE
	CALL	SPACE
	POP	PSW
	JNZ	NEXT
	CALL	CRLF
	JMP	LINE
;.....
;
;
; Write the filename pointed to by DE into the SUB file buffer in the
; format: $1<fn.ft>$2<cr><lf>
;
NAMSUB:	PUSH	H		;save hl (whatever's in it)
	PUSH	D		;save filename pointer
	PUSH	B		;save bc (whatever's in it)
	LHLD	SUBPTR		;hl to sub buffer (de to filename)
	MVI	C,8		;8 characters in filename
	MVI	M,'$'		;first write '$1'
	CALL	INCPTR		;increment file buffer pointer and..
	MVI	M,'1'		;..write if full
	CALL	INCPTR
;
SNAM:	LDAX	D		;get a character of the name
	CPI	' '	       ;do not transfer spaces to sub buffer
	JZ	SNAM2
	ANI	7FH		;trim off any nasty attributes
	MOV	M,A		;put the character into the sub buffer
	CALL	INCPTR		;point to next sub location
;
SNAM2:	INX	D		;point to next character of filename
	DCR	C		;decrement filename counter
	JNZ	SNAM		;continue until all 8 characters read
	MVI	M,'.'		;put a '.' separator into the sub buffer
	CALL	INCPTR		;point to next location in sub buffer
	MVI	C,3	;now do the 3 character long filetype
;
SNAM3:	LDAX	D
	CPI	' '
	JZ	SNAM4
	ANI	7FH
	MOV	M,A
	CALL	INCPTR
;
SNAM4:	INX	D
	DCR	C
	JNZ	SNAM3
	MVI	M,'$'		;then write '$2<cr><lf>' on the end..
	CALL	INCPTR		;.. of the name
	MVI	M,'2'
	CALL	INCPTR
	MVI	M,CR
	CALL	INCPTR
	MVI	M,LF
	CALL	INCPTR
	SHLD	SUBPTR		;save the new sub buffer pointer
	POP	B		;restore all the registers
	POP	D
	POP	H
	RET			;then return back to doname
;.....
;
;
; Increment the HL file buffer pointer, and write the buffer if full
;
INCPTR:	INX	H		;see if buffer is full
	MVI	A,(SUBBUF+80H) AND 0FFH
	CMP	L		;(see if lsh of hl = lsh of subbuf+80h)
	RNZ			;return if buffer not full
WRTSBF:	LXI	H,SUBBUF	;reset pointer to start of buffer
;
WRTSB2:	PUSH	H
	PUSH	D
	PUSH	B
	LXI	D,SUBBUF	;set dma address to sub buffer
	MVI	C,SETDMA
	CALL	BDOS
	LXI	D,LFCB		;write the buffer to disk
	MVI	C,WRITE
	CALL	BDOS
	LXI	D,CPMBUFF	;now set dma address back to default so
	MVI	C,SETDMA	;..other routines can read directory
	CALL	BDOS
	POP	B
	POP	D
	POP	H
	ORA	A		;notify console and abort if write error
	JNZ	WRERR
	RET
;
CKNONE:	LDA	GOTFLG		;some new files found?
	ORA	A
	JNZ	NOTFND		;jump if yes
	LDA	PRTFLG		;print names?
	ORA	A
	JNZ	NOTFND		;jump if yes
	CALL	ILPRT
	DB	'++ NONE ++',CR,LF,0
;
;
; Print the files not found
;
NOTFND:	LDA	SETFLG		;is this 'D SET'?
	ORA	A
	JNZ	FINI		;done if so
	LDA	PRTFLG		;are we printing?
	ORA	A
	JNZ	CKNON2		;done if not
;
; If this D.COM is dedicated ("DRIVE" is non-zero), then be sure to
; print the "FILES NOT FOUND".
;
	LDA	DRIVE
	ORA	A
	JNZ	NOCHK
	LDA	FCB		;drive specified?
	ORA	A
	JNZ	FINI		;skip not found if so
;
NOCHK:	CALL	HEAD3		;print not fnd header
	LXI	H,NAMES		;start of table
	LXI	D,11
;
LINE2:	MVI	B,NPL
	CALL	LINMRK
;
NEXT2:	MOV	A,M		;first char of name
	ORA	A		;marked found?
	JZ	NOPRNT		;jump if so
	INR	A		;check for table end
	JZ	CKNON2		;jump if end
	MVI	A,1
	STA	GOTNF
	MVI	C,8
	CALL	TYPMEM
	MVI	A,'.'
	CALL	TYPE
	MVI	C,3
	CALL	TYPMEM
	CALL	SPACE
	MVI	A,FENCE
	DCR	B
	PUSH	PSW
	CNZ	TYPE
	CALL	SPACE
	POP	PSW
	JNZ	NEXT2
	CALL	CRLF
	JMP	LINE2
;
NOPRNT:	DAD	D
	JMP	NEXT2
;.....
;
;
; Print header
;
HEAD1:	CALL	ILPRT		;print:
	DB	CR,LF,'-->New files',0
	LDA	DATE
	CPI	' '
	JZ	HEAD2
	CALL	SYSCK
	JZ	HEAD2
	CALL	ILPRT		;print:
	DB	' since '
;
DATE:	DB	'        '	;eight spaces
	DB	0		;string terminator
	JMP	CRLF
;
HEAD2:	MVI	A,':'
	CALL	TYPE
	JMP	CRLF
;.....
;
;
HEAD3:	CALL	ILPRT		;print:
	DB	CR,LF,CR,LF,'-->Files moved elsewhere or deleted',0
	LDA	DATE
	CPI	' '
	JZ	HEAD5
	CALL	SYSCK
	JZ	HEAD5
	CALL	ILPRT		;print:
	DB	' since '
;
DATE1:	DB	'        '	;eight spaces
	DB	0		;string terminator
;
HEAD4:  CALL	ILPRT
	DB	CR,LF,'   (use FILE xxx*.* to see if available)'
	DB	CR,LF,0
	RET
;
HEAD5:	MVI	A,':'
	CALL	TYPE
	JMP	HEAD4
;.....
;
;
CKNON2:	LDA	GOTNF
	ORA	A
	JNZ	FINI		;jmp if got no 'NOT FOUND's
	LDA	PRTFLG
	ORA	A
	JNZ	FINI
	CALL	ILPRT		;print: (then fall into 'FINI')
	DB	'++ NONE ++',CR,LF,0
;
;
; Finished.  If building table, write back.  If making a SUB file, then
; flush the file buffer and close it.
;
FINI:	LDA	SUBFLG		;see if sub file is to be written
	ORA	A
	JNZ	WRTSUB		;jump if so,
	LDA	SETFLG		;else see if set was performed
	ORA	A
	JZ	EXIT		;jump out if not,
	JMP	WRBACK		;else write the program back to disk
;
;
; Write the SUB file to the currently logged in disk as 'D.SUB'
;
WRTSUB:	LHLD	SUBPTR		;fill rest of last sector with eof's
	XCHG
	LXI	H,SUBBUF+7FH
;
WNXTS:	MVI	M,1AH
	MOV	A,L
	DCX	H
	CMP	E
	JNZ	WNXTS
	CALL	WRTSB2		;write the last sector to disk
	MVI	C,CLOSE		;close the file
	LXI	D,LFCB
	CALL	BDOS
	INR	A		;if close error, then notify console..
	JZ	BADWCL		;..and abort
	JMP	EXIT		;exit back to cp/m
;
BADWCL:	CALL	MSGXIT
	DB	'BAD CLOSE, SUB file incomplete$'
;
;
; Set up the name in the table
;
SETUP:
	 IF	NOSYS
	CALL	SYSCK
	JZ	SETU2
	LDA	SYSFLG
	RAL
	JC	SETSKP
	 ENDIF			;NOSYS
;
SETU2:	CALL	FINDFF		;find end of table
	XCHG			;setup for move
;
;
; (HL = name, DE = end of table)
;
	LXI	B,11
	CALL	MOVER
	MVI	A,0FFH		;get table end flag
	STAX	D		;store it
;
SETSKP:	POP	B		;delete stack garbage
	JMP	NEXT		;get next entry
;
;
; Routine to type 'C' characters from memory (HL)
;
TYPMEM:	MOV	A,M
	CALL	TYPE
	INX	H
	DCR	C
	JNZ	TYPMEM
	RET
;.....
;
;
; Inline print routine - prints string pointed to by stack until a zero
; is found.  Returns to caller at next address after the zero terminator.
;
ILPRT:	XTHL			;save hl, get msg adrs
;
ILPLP:	MOV	A,M		;get char
	CALL	TYPE		;output it
	INX	H		;point to next
	MOV	A,M		;test
	ORA	A		;..for end
	JNZ	ILPLP
	XTHL			;restore hl, ret addr
	RET			;ret past msg
;.....
;
;
CRLF:	CALL	ILPRT	;print:
	DB	CR,LF,0
	RET
;.....
;
;
SPACE:	MVI	A,' '
;
;
; Print character in A to console
;
TYPE:	PUSH	B
	PUSH	D
	PUSH	H
	MOV	C,A		;char to c for cbios
;
TYPEC:	CALL	$-$		;supplied at start
;
;
; See if console key pressed
;
TYPES:	CALL	$-$		;supplied at start
	ORA	A		;key pressed?
	CNZ	CKKB		;yes, see which one
	POP	H
	POP	D
	POP	B
	RET
;.....
;
;
CKKB:	CALL	CI		;get char
	CPI	'S'-40H		;pause?
	CZ	CI		;yes, get next char
	CPI	'C'-40H		;abort?
	RNZ			;no, return
	CALL	MSGXIT
	DB	CR,LF,'++ ABORTED ++$'
;.....
;
;
; Move (BC) bytes from (HL) to (DE)
;
MOVER:	MOV	A,M
	STAX	D
	INX	D
	INX	H
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	MOVER
	RET
;.....
;
;
; Compare routine
;
COMPR:	LDAX	D
	CMP	M
	RNZ
	INX	D
	INX	H
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	COMPR
	RET			;equal means z=1
;.....
;
;
; Routine to find 0FFH at end of table
;
FINDFF:	LXI	H,NAMES
;
FINDLP:	MOV	A,M
	INX	H
	INR	A		;0ffh?
	JNZ	FINDLP
	DCX	H		;back up to table end
	RET
;.....
;
;
; Delete the name from the table
;
DELNAM:	LXI	H,NAMES
;
DELLP:	MOV	A,M
	CPI	YES
	STC
	RZ			;not found
	LXI	D,FCB+17
	LXI	B,11
	CALL	COMPR
	JZ	DELETE
	DAD	B		;calc next
	JMP	DELLP
;.....
;
;
; Delete the name
;
DELETE:	XCHG			;next name to de
	LXI	H,-11		;to back up..
	DAD	D		;..to name to del
;
DELCH:	LDAX	D
	MOV	M,A
	INX	H
	INX	D
	INR	A		;moved the 0ffh?
	JNZ	DELCH
	ORA	A		;show found
	RET
;.....
;
;
; Fill FCB with all '?'
;
FILLQ:	LXI	H,FCB+1
	MVI	B,8+3
	MVI	A,'?'
;
QMLOOP:	MOV	M,A
	INX	H
	DCR	B
	JNZ	QMLOOP
	RET
;.....
;
;
; Write back the program - note that you may set any of the CP/M 2.x
; attribute bits in the file name (be sure to define all 11 characters
; of the name).
;
WRBACK:	LXI	D,FCB+1
	CALL	WRBK2
;
WRBK1:	DB	'D'+80H		;<--put 'D'+80h here to set tag
	DB	'       COM'	 ;see comment above
	DB	0		;extent number
;
WRBK2:	POP	H
	LXI	B,WRBK2-WRBK1
	CALL	MOVER
	MVI	C,ERASE
	LXI	D,FCB
	CALL	BDOS
	XRA	A		;get 0
	STA	SETFLG		;clear the flags..
	STA	GOTFLG
	STA	GOTNF
	STA	SYSTOO
	STA	FCBRNO		;zero record number
	MVI	C,MAKE
	LXI	D,FCB
	CALL	BDOS
;
;
; Before writing back, find end of table
;
	CALL	FINDFF
	MOV	B,H		;b=end page
	INR	B		;for compare
	LXI	D,100H+BIAS	;starting addr
;
WRLP:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,SETDMA
	CALL	BDOS
	MVI	C,WRITE
	LXI	D,FCB
	CALL	BDOS
	POP	H
	POP	D
	POP	B
	ORA	A		;successful write?
	JNZ	WRERR		;..no
	LXI	H,80H		;point to..
	DAD	D		;..next block
	XCHG			;addr to de
	MOV	A,D		;get page
	CMP	B		;past table end?
	JC	WRLP		;loop until done
	MVI	C,CLOSE
	LXI	D,FCB
	CALL	BDOS
	INR	A		;successful close?
	JZ	BADCLS		;..no, print err msg
	CALL	MSGXIT		;ok, exit w/msg
	DB	'++ DONE ++$'
;.....
;
;
WRERR:	CALL	MSGXIT
	DB	'++ WRITE ERROR ++$'
;.....
;
;
BADCLS:	CALL	MSGXIT
	DB	'++ BAD CLOSE, D.COM CLOBBERED ++$'
;.....
;
;
; Get console input via direct CBIOS call
;
CI:	PUSH	B		;console input
	PUSH	D
	PUSH	H
;
CIC:	CALL	$-$		;supplied at start
	POP	H
	POP	D
	POP	B
	RET
;.....
;
;
; Exit with message (error or informational)
;
MSGXIT:	POP	D		;get msg
	MVI	C,PRINT
	CALL	BDOS
;
;
; Exit, restoring DMA and stack, then return to CCP
;
EXIT:	LXI	D,CPMBUFF	;reset dma adr to normal
	MVI	C,SETDMA
	CALL	BDOS
	LHLD	STACK		;get old stack
	SPHL			;restore it
	RET			;return to ccp
;.....
;
;
LINMRK:	PUSH	B
	PUSH	D
	PUSH	H
	LDA	FCB		;get drive name from fcb
	ORA	A		;any there?
	JNZ	GOTDRV		;yes, go print it
	MVI	C,CURDSK	;else get current disk
	CALL	BDOS
	INR	A		;make 'A'=1
;
GOTDRV:	ADI	40H		;make ascii
	CALL	TYPE		;print drive name
	CALL	ILPRT		;print
	DB	': ',0
	POP	H
	POP	D
	POP	B
	RET
;.....
;
;
; Test for system file override
;
SYSCK:	PUSH	H
	PUSH	D
	PUSH	B
	LXI	H,SYSTOO
	LXI	D,SYSOK
	MVI	B,3
;
RSYSCK:	LDAX	D
	CMP	M
	INX	H
	INX	D
	JNZ	SYSOUT
	DCR	B
	JNZ	RSYSCK
;
SYSOUT:	POP	B
	POP	D
	POP	H
	RET
;.....
;
;
	DS	64		;room for stack
STACK:	DS	2		;old stack stored here
SUBFLG	DB	00H		;flag to order sub file built
SUBPTR	DW	0000H		;pointer to end of sub file
GOTFLG:	DB	0
GOTNF:	DB	0
SYSTOO:	DB	0,0,0
SYSOK:	DB	'S  '	      ;sys suppression override chars
SETFLG:	DB	0		;1 => setup table
PRTFLG:	DB	0		;print only some
SYSFLG:	DB	0		;$sys attrib indicator
LFCB	DS	36H		;local fcb used by sub file
SUBBUF	DS	128		;buffer used by sub file write routines
NAMES	EQU	$		;names not to print are stored here..
				;..(i.e., the current dir)
;
; Note the names are initially built by the "D SET" command
;
	DB	0FFH	;end of table
;
;
; Miscellaneous BDOS equates
;
RDCON	EQU	1
DIO	EQU	6
PRINT	EQU	9
CONST	EQU	11
SELDSK	EQU	14
CLOSE	EQU	16
SRCHF	EQU	17
SRCHN	EQU	18
ERASE	EQU	19
READ	EQU	20
WRITE	EQU	21
MAKE	EQU	22
CURDSK	EQU	25
SETDMA	EQU	26
;
	END