; DSKNUM.MAC  (formerly DISKNUM.MAC)
;
Vers	equ	14
SubVers	equ	' '		; revision level
;
; A ZCPR33+ utility to create null disk labels.
;
; USAGE:
;
;	DSKNUM {dir:}{label}{.num} {{/}options}
;
; If a DIR or DU specification is not given, the current drive and/or
; user is assumed, unless an internal default user is installed.  If
; no label name is given, an internal default is used.  If no disk
; number is given, the internal next number is used.  If no option is
; given, DSKNUM labels a single disk and exits.  By default DSKNUM
; saves the last number used internally, so you won't have to remember
; what it was.
;
; OPTIONS:  Slash not required if option is second token.
;
;	M	Multiple label mode.
;
;	S	Do not save last disk number.
;
; Numerous configuration options are available in the first sector of
; the program COM file.  See documentation for more information.
;
; Let me know if there are any problems.
;
; 	Gene Pizzetta
;	481 Revere Street
;	Revere, MA  02151
;
;	Voice:  (617) 284-0891
;	Newton Centre Z-Node:  (617) 965-7259
;	GEnie:  E.Pizzetta
;
; Version 1.4 -- July 28, 1990 -- Gene Pizzetta
;	Complete rewrite.  Requires ZCPR 3.3 or higher.  Name changed to
;	DSKNUM from DISKNUM.  Labels a single disk from command line.
;	Still labels multiple disk interactively.  Accepts label name
;	from command line in lieu of internal default label name.  Accepts
;	disk number from command line in lieu of internal stored number.
;	Label attributes configurable.  Gets its own filename and directory
;	location from external file control block on first invocation.
;	Name is stored for subsequent execution with GO command.  Has
;	type 3 header.  Resets only target disk instead of entire disk
;	system under Z3PLUS and ZSDOS.  Configurable to reset disk or not
;	when saving last number internally (resets not needed for hard
;	drives).  Accepts target user area from command line or configurable
;	to use internal default user.  Aborts if label already exists on disk.
;	Sets ZCPR3 error flag if an invalid DU is given (2), if the disk
;	number exceeds 999 (9), if the disk is out of directory space (11),
;	if a label already exists on the disk (16), if an invalid option
;	is given (19), or any other error (4).  ^C aborts to operating
;	system at any prompt.  Brief usage screen if "//" is given.
;	Configurable with ZCNFG 1.6 or higher.
;
; Version 1.3 -- March 3, 1989 -- Gene Pizzetta
;	Minor bug correction.
;
; Version 1.2 -- February 28, 1989 -- Gene Pizzetta
;	Corrected several file handling problems in CP/M 2.2 version.
;	Added user area support.
;
; Version 1.1 -- December 26, 1987 -- Gene Pizzetta
;	Added CP/M 2.2 support.
;
; Version 1.0 -- December 24, 1987 -- Gene Pizzetta
;	Original release for CP/M-Plus.
;
; Developed with SLRMAC and SLRNK+.
;
; System addresses . . .
;
CpmFcb	equ	05Ch		; default file control block
CpmDma	equ	080h		; default DMA buffer
;
; Character codes . . .
;
CtrlC	equ	03h		; ^C
BEL	equ	07h		; bell
TAB	equ	09h		; tab
CR	equ	0Dh		; carriage return
LF	equ	0Ah		; linefeed
ESC	equ	1Bh		; escape
;
; BDOS service functions . . .
;
CpmVer	equ	12		; CP/M version request
ResSys	equ	13		; reset disk system
FSrchF	equ	17		; search for first match
SetAtt	equ	30		; set file attributes
ResDrv	equ	37		; reset individual drives
DosVer	equ	48		; ZRDOS, ZSDOS version request
;
	MACLIB	Z80		; this is extended Intel
;
; Routines from VLIB, Z3LIB, and SYSLIB . . .
;
	ext	bdos,epstr,crlf,pafdc,cout,cin,isdigit,comphd,eval10,phl4hc
	ext	retud,logud,initfcb,setdma,f$open,f$mopen,f$close,r$write
	ext	zsyschk,z33chk,z3vinit,gzmtop,tinit,dinit,getefcb,pfn1
	ext	prtname,puter2
	ext	stndout,stndend
;
; TYP3HDR.MAC, Version 1.1  --  Extended Intel Mnemonics
; This code has been modified as suggested by Charles Irvine so that
; it will function correctly with interrupts enabled.
; Extended Intel mnemonics by Gene Pizzetta, April 30, 1989.
;
Entry:	jr	Start0		; must use relative jump
	db	0		; filler
	db	'Z3ENV',3	; type-3 environment
Z3EAdr:	dw	0FE00h		; filled in by Z33
	dw	Entry		; intended load address
;
; Configuration area . . .
;
	db	'DSKNUM'	; default name for CFG file
	db	Vers/10+'0',Vers mod 10+'0'	; version for CFG file
	db	'ROFLG>'	; set read-only attribute in label
ROFlg	db	0		; ..0 = no, non-zero = yes
	db	'SYSFLG>'	; set system attribute in label
SysFlg:	db	0		; ..0 = no, non-zero = yes
	db	'ARCFLG>'	; set archive attribute in label
ArcFlg:	db	0		; ..0 = no, non-zero = yes
	db	'RSTFLG>'	; reset drive before saving number
RstFlg:	db	0		; ..0 = no, non-zero = yes
	db	'LBLTAG>'	; first character of label
LblTag:	db	'#'		; "!" or "#" recommended
	db	'DFTLBL>'	; default disk label, if not given
DftLbl:	db	'DISK   <'	; ..(7 upper-case characters)
	db	'LBLUSR>'	; user area for label, or FF to use
LblUsr:	db	0FFh		; ..current or given user
LstNum:	dw	0		; last number written to disk
;
Start0:	lxi	h,0		; point to warmboot entry
	mov	a,m		; save the byte there
	di			; protect against interrupts
	mvi	m,0C9h		; replace warmboot with a return opcode
	rst	0		; call address 0, pushing RetAddr onto stack
RetAddr:
	mov	m,a		; restore byte at 0
	dcx	sp		; get stack pointer to point
	dcx	sp		; ..to the value of RetAddr
	pop	h		; get it into HL and restore stack
	ei			; we can allow interrupts again
	lxi	d,RetAddr	; this is where we should be
	xra	a		; clear carry flag
	push	h		; save address again
	dsbc	de		; subtract -- we should have 0 now
	pop	h		; restore value of RetAddr
	jz	Start		; if addresses matched, begin real code
;
	lxi	d,NotZ33Msg-RetAddr ; offset to message
	dad	d
	xchg			; switch pointer to message into DE
	mvi	c,9
	jmp	0005h		; return via BDOS print string function
;
NotZ33Msg:
	db	'Not Z33+$'	; abort message if not Z33-compatible
;
; Messages . . .
;
MsgUse:	db	'DSKNUM    Version '
	db	Vers/10+'0','.',Vers mod 10+'0',SubVers
	db	'  (loaded at ',0
MsgUs1:	db	'h)',CR,LF
	db	'Usage:',CR,LF,'   ',0
MsgUs2:	db	' {dir:}{label}{.num} {{/}options}',CR,LF
	db	'Options:',CR,LF
	db	'   M   Multiple label mode',CR,LF
	db	'   S   Don''t save last number',0
MsgNxt:	db	'Next Label: ',0
MsgDot:	db	' .. ',0
MsgDsk:	db	' .. Press any key (ESC = Quit) .. ',0
MsgRng:	db	BEL,'Next number out of range',0
MsgBad:	db	BEL,'Bad disk number',0
MsgIOp:	db	BEL,'Invalid option',0
MsgExs:	db	BEL,'Label exists',0
MsgFDr:	db	BEL,'No directory space',0
MsgIDr:	db	BEL,'Invalid directory',0
MsgWEr:	db	BEL,'File write error, ',0
MsgNSv:	db	'Not saved',0
MsgZ33:	db	BEL,'ZCPR33+ required',0
MsgPrg:	db	BEL,'Can''t find ',0
MsgAgn:	db	' .. Any key to try again .. ',0
MsgAbt:	db	'Aborted',0
MsgDne:	db	'Saved',0
;
; Start of program . . .
;
Start:	lhld	Z3EAdr
	call	z3vinit
	call	z33chk		; check for ZCPR33+
	lxi	h,MsgZ33
	jnz	epstr		; (it's not)
	sspd	OldStk		; save old stack pointer
	lxi	h,OldStk
	sphl			; ..and set up new stack
;
	lda	PrgNam		; is this a rerun?
	cpi	' '
	jrnz	Start1		; (yes, it is)
	call	getefcb		; get external FCB address
	inx	h		; increment it to filename (EFCB+1)
	lxi	d,PrgNam	; ..and move program name to storage
	lxi	b,11
	ldir
	inx	h		; point to program user (EFCB+13)
	mov	a,m		; ..and move to storage
	sta	PrgUsr
	inx	h		; point to program drive (EFCB+14)
	mov	a,m		; move program drive to storage
	dcr	a		; make A=0
	sta	PrgDrv
Start1:	call	ScanOp		; scan for options
	lda	CpmFcb+15	; valid directory?
	ora	a
	jrz	Skip1
	mvi	a,2		; set error code (invalid directory)
	sta	ErCode
	lxi	h,MsgIDr
	jmp	Exit		; (nope)
Skip1:	call	tinit		; initialize terminal
	call	retud		; get default DU
	mov	a,b		; store drive
	sta	TgtDrv
	lda	CpmFcb		; get drive, if any
	ora	a
	jrz	Start2		; (no drive, use default)
	dcr	a
	sta	TgtDrv
Start2:	lda	LblUsr		; check for default user
	cpi	32
	jrc	Start3
	lda	CpmFcb+13	; get user
Start3:	sta	TgtUsr
	mov	c,a		; put user in C
	lda	TgtDrv		; put drive in B
	mov	b,a
	call	logud		; log into target DU
	lda	LblTag		; move label tag to FCB
	sta	LblFcb+1
	lxi	h,CpmFcb+1	; check for filename (label)
	mov	a,m
	cpi	' '
	jrz	Start4		; (none, use default)
	cpi	'/'
	jrz	Start4
	mov	b,a		; see if tag was given
	lda	LblTag
	cmp	b
	jrnz	Start5		; (no)
	inx	h		; point past tag
	jr	Start5
Start4:	lxi	h,DftLbl	; move default disk label to FCB
Start5:	lxi	d,LblFcb+2
	lxi	b,7
	ldir
	lxi	h,CpmFcb+9	; check for filetype (number)
	mov	a,m
	cpi	' '
	jrz	Start6		; (none, use default)
	call	isdigit
	jrnz	BadNum		; (not a digit, so abort)
	call	eval10		; get number
	mov	a,m		; get terminating character
	xchg			; move from DE to HL
	ora	a		; was character a null?
	jrz	Start7		; (yes, okay)
	cpi	' '		; a space?
	jrz	Start7		; (okay, too)
BadNum:	mvi	a,9		; it's a bad number
	sta	ErCode
	lxi	h,MsgBad
	jmp	Exit
;
Start6:	lhld	LstNum		; get last number
	call	NumChk
	inx	h		; increment it
Start7:	shld	CurNum		; save it as current number
	lxi	d,LblFcb+9	; insert it into FCB
	call	mhl3dc
	lda	OpMFlg		; check for mode
	ora	a
	jrnz	MMode		; (multiple label mode)
;
; Single label module . . .
;
	call	PrtNxt		; print next label
	lxi	h,MsgDot
	call	epstr
	call	DskRst		; reset disk
	call	ChkDup		; labelled already?
	jnz	Exit		; (yep)
	call	MakFil		; create label
	jnz	Exit		; (space error)
	call	FilAtt		; set attributes
	lda	OpSFlg		; do we save last number?
	ora	a
	jrnz	NoSave		; (no)
	lhld	CurNum		; get last label number used
	shld	LstNum		; ..and store in data sector
	call	DskSav		; save last number
	jmp	Finish
;
; Multiple label module . . .
;
MMode0:	call	crlf
MMode:	call	PrtNxt		; print next label
	lxi	h,MsgDsk	; press any key ...
	call	AskOpr
	cpi	ESC		; quitting?
	jrz	MMode1		; (yes)
	call	DskRst		; reset disk
	call	ChkDup		; labelled already?
	cnz	epstr
	jnz	MMode0		; (yep)
	call	MakFil		; create label
	cnz	epstr
	jnz	MMode0
	call	FilAtt
	lhld	CurNum		; get last label number used
	shld	LstNum		; ..and store in data sector
	call	NumChk
	inx	h		; increment it
	shld	CurNum		; save it as current number
	lxi	d,LblFcb+9	; insert it into FCB
	call	mhl3dc
	jr	MMode0		; ..and loop
;
MMode1:	lda	OpSFlg		; are we saving number?
	ora	a
	jrnz	NoSave		; (no)
	call	DskSav		; yes, go do it
	jmp	Finish
;
; Common exit routines . . .
;
NoSave:	lxi	h,MsgNSv
	jr	Exit
;
Finish:	lxi	h,MsgDne
	jr	Exit
;
Abort:	lxi	h,MsgAbt
	mvi	a,4		; set error code
	sta	ErCode
Exit:	call	epstr
	call	dinit		; clear terminal
	lda	ErCode
	call	puter2
	lspd	OldStk
	ret
;
; Subroutines . . .
;
; DskSav -- Save data sector to disk.
;
DskSav:	call	DskRs0		; reset disk system
	lxi	h,PrgNam	; put program name in FCB
	lxi	d,LblFcb+1
	lxi	b,11
	ldir
	lda	PrgDrv		; log into program DU
	mov	b,a
	lda	PrgUsr
	mov	c,a
	call	logud
DskSv1:	lda	RstFlg		; do we reset drive?
	ora	a
	cnz	DskRst		; (yes)
	lxi	d,LblFcb
	call	initfcb
	call	f$open		; open ourselves
	jrnz	GetDsk		; we can't find ourselves
;
	lxi	h,Entry		; set dma address to our 1st record
	call	setdma
	lxi	h,0		; set record number
	call	r$write		; write record
	jrnz	DskErr		; (error)
	call	f$close		; close file
	ret
;
GetDsk:	call	crlf
	lxi	h,MsgPrg	; request program disk
	call	PrtNx1
	lxi	h,MsgAgn
	call	AskOpr
	jr	DskSv1		; ..and try again
;
DskErr:	call	crlf
	lxi	h,MsgWEr	; file write error
	call	epstr
	jmp	Abort
;
; FilAtt -- Sets label attributes based on configuration bytes.
;
FilAtt:	lda	ROFlg		; check read-only flag
	ora	a
	jrz	FilAt1		; (no, skip read-only)
	lda	LblFcb+9	; set read-only attribute
	ori	80h		; ..Read Only
	sta	LblFcb+9
FilAt1:	lda	SysFlg		; check system flag
	ora	a
	jrz	FilAt2		; (no, skip system)
	lda	LblFcb+10	; set system attribute
	ori	80h
	sta	LblFcb+10
FilAt2:	lda	ArcFlg		; check archive flag
	ora	a
	jrz	FilAt3		; (no, skip archive)
	lda	LblFcb+11	; set archive attribute
	ori	80h
	sta	LblFcb+11
FilAt3:	lxi	d,LblFcb
	mvi	c,SetAtt
	call	bdos
	ret
;
; DskRst -- resets current drive only under ZSDOS and CP/M-Plus;
; otherwise, resets disk system.  (Based on Carson Wilson's RCPR v1.5
; for Z34RCP.)
;
DskRst:	mvi	c,CpmVer	; get CP/M version
	call	bdos
	cpi	30h		; CP/M Plus?
	jrnc	DskRs1		; (yes)
	mvi	c,DosVer
	call	bdos		; ZRDOS or CP/M?
	mov	a,h
	ora	a
	jrnz	DskRs1		; (no, assume function 37 is bug-free
DskRs0:	mvi	c,ResSys	; reset disk system
	call	bdos
	ret
; reset single drive
DskRs1:	call	retud		; get current drive
	mov	a,b		; put it in A
	inr	a		; shift range to 1..16
	lxi	h,1		; map drive "A:"	
DskRs3:	dcr	a		; done yet?
	jrz	DskRs4		; (yes)
	dad	h		; shift vector to next drive
	jr	DskRs3
DskRs4:	xchg			; put vector in DE
	mvi	c,ResDrv	; reset single drive
	call	bdos
	ret
;
; MakFil -- create, open, and close a zero-length file.  Return
; Z if okay, NZ if no directory space.
;
MakFil:	lxi	d,LblFcb
	call	initfcb
	call	f$mopen		; create and open file
	jrnz	MakFi1		; (no directory space)
	call	f$close		; close file
	ret
;
MakFi1:	mvi	a,11		; set error code (directory full)
	sta	ErCode
	lxi	h,MsgFDr
	ret
;
; ChkDup -- checks for an existing filename beginning with the
; tag character.  Returns Z if not found, NZ if found.
;
ChkDup:	lda	LblTag		; stuff label tag into FCB
	sta	CpmFcb+1
	lxi	h,WildNm	; fill rest with ?'s
	lxi	d,CpmFcb+2
	lxi	b,10
	ldir
	lxi	d,CpmFcb
	call	initfcb
	mvi	c,FSrchF	; does it exist?
	call	bdos
	inr	a
	rz
	mvi	a,16		; set error code (duplicate filespec ?!?)
	sta	ErCode
	lxi	h,MsgExs	; say label exists
	ret
;
; ScanOp -- scan command line for options
;
ScanOp:	xra	a		; initialize option flags
	sta	OpMFlg
	sta	OpSFlg
	sta	ErCode		; ..and error code
	lxi	h,CpmDma+1	; point to command line
	call	EatSpc		; jump past spaces
	inx	h
	ora	a
	rz			; (no more)
	cpi	'/'		; option flag?
	jrz	GetOpt		; (yes)
ScanO1:	mov	a,m		; get past filespec
	inx	h
	ora	a
	rz			; (no more)
	cpi	' '
	jrz	ScanO2
	cpi	TAB
	jrnz	ScanO1
ScanO2:	call	EatSpc
	ora	a
	rz			; (no more)
	cpi	'/'
	jrnz	GetOpt
	inx	h
;
GetOpt:	mov	a,m		; get option
	ora	a
	rz			; (no more)
	cpi	'/'		; help request?
	jrz	Usage
	cpi	'M'
	jrz	SetMOp
	cpi	'S'
	jrz	SetSOp
	inx	h
	cpi	' '
	jrz	GetOpt
	mvi	a,19		; set error code (invalid option)
	sta	ErCode
	lxi	h,MsgIOp
	jmp	Exit
;
SetMOp:	mvi	a,0FFh
	sta	OpMFlg
	inx	h
	jr	GetOpt
;
SetSOp:	mvi	a,0FFh
	sta	OpSFlg
	inx	h
	jr	GetOpt
;
Usage:	lxi	h,MsgUse	; print usage message
	call	epstr
	lxi	h,Entry		; print load address
	call	phl4hc
	lxi	h,MsgUs1
	call	epstr
	call	prtname
	lxi	h,MsgUs2
	jmp	Exit
;
; EatSpc -- Gobbles up spaces and tabs
;
EatSpc:	mov	a,m
	inx	h
	cpi	' '		; is it a space?
	jrz	EatSpc		; (yes)
	cpi	TAB		; it it a tab?
	jrz	EatSpc		; (yes)
	dcx	h
	ret
;
; AskOpr -- get response from user
;
AskOpr:	call	epstr
	call	cin		; wait for character
	cpi	CtrlC		; ^C ?
	rnz			; (nope)
	jmp	Abort
;
; MHL3DC -- Store HL as 3 decimal characters in 3-byte memory buffer
; pointed to by DE (based on Carson Wilson's SMHL5DC+ module in ZSLIB 2.1).  
;
MHL3DC:	push	psw		; save regs
	push	b
	push	h
	pushix
	push	d		; for output
	popix
	mvi	b,0		; B=0 for no leading spaces
	lxi	d,100		; store 100's
	call	MHDC1
MHDC6:	lxi	d,10		; store 10's
	call	MHDC1
	mov	a,l		; store 1's
	adi	'0'		; convert to ASCII
	call	MHDC8
	popix			; restore regs
	pop	h
	pop	b
	pop	psw
	ret
;
;  Divide HL by DE and store quotient with leading spaces
;
MHDC1:	xra	a		; set count
MHDC2:	ora	a		; clear carry
 	dsbc	de
	jrc	MHDC3		; done if carry set (further borrow)
	inr	a		; increment count
	jr	MHDC2
MHDC3:	dad	d
	ana	a		; check for zero
	jrnz	MHDC4
	ora	b		; 0 = no leading spaces (A=0, A or B = 0 if B=0)
	jrz	MHDC4
	mvi	a,' '		; store space
	jr	MHDC8
MHDC4:	mvi	b,0		; turn off leading spaces for rest of output
MHDC7:	adi	'0'		; convert to ASCII
MHDC8:	pushix			; get storage address
	pop	d
	inxix
	call	MOUT
	ret
;
; MOUT - Store A to memory at DE (from Carson Wilson's ZSLIB 2.1)
;	Entry:	 A = value to store
;		DE = address of memory buffer (1 byte)
;	Exit:	DE = address of byte after output
;	Uses:	DE
;
MOUT:	stax	d
	inx	d
	ret
;
; NumChk -- checks if number is 999 and, if so, aborts.
;
NumChk:	lxi	d,999
	call	comphd
	rc
	lda	OpMFlg		; check mode
	ora	a
	cnz	crlf
	mvi	a,9		; set error code (bad numerical expression)
	sta	ErCode
	lxi	h,MsgRng
	jmp	Exit
;
; PrtNxt -- Print next disk label
;
PrtNxt:	lxi	h,MsgNxt	; report next label
PrtNx1:	call	epstr
	call	stndout
	call	retud		; get current DU
	mov	a,b		; put drive in A
	adi	'A'		; make it printable
	call	cout
	mov	a,c		; put user in A
	call	pafdc
	mvi	a,':'		; print colon
	call	cout
	lxi	d,LblFcb+1	; print label
	call	pfn1
	call	stndend
	ret
;
; Data . . .
;
PrgNam:	db	'           '	; program name storage
PrgDrv:	db	0		; program drive location
PrgUsr:	db	0		; program user location
WildNm:	db	'??????????'	; for existence test
;
; Uninitialized data . . .
;
	DSEG
;
OpMFlg:	ds	1		; non-zero = option M (multiple labels)
OpSFlg:	ds	1		; non-zero = option S (don't save)
CurNum:	ds	2		; current label number
TgtDrv:	ds	1		; default drive
TgtUsr:	ds	1		; default user
ErCode:	ds	1		; error code
	ds	50		; stack
OldStk:	ds	2		; stack pointer storage
LblFcb:	ds	36		; label file control block
;
	end