; CONCAT.MAC -- file concatenation utility
;
Vers	equ	10		; version number
SubVers	equ	' '		; modification level
;
; Concatenates two or more source files into a destination file.
; For ZCPR3 only.
;
; USAGE:
;
;	CONCAT {dir:}outfile = {dir:}infile {{dir:}infile {...}} {/options}
;
; Any file without a DU or DIR specification is assumed to be in
; the current drive/user.
;
; OPTIONS:
;
;	A	Append mode.  Appends sources files to end of target
;		file, which must exist.
;
;	D	Insert date and time.  The current system date and time
;		is inserted at the head of new output file or, in append
;		mode, at the end of the existing file before any files
;		are appended.  Incompatible with O option.
;
;	O	Object file mode; ignore ^Z.  The default is text mode,
;		checking for a ^Z (CP/M end-of-file character).  Incom-
;		patible with D option.
;
;	Q	Toggle quiet mode.  A configuration byte at 111h decides
;		whether CONCAT will print the names of the output and
;		source files (a non-zero value defaults to quiet mode).
;		This option puts CONCAT in the opposite mode.  Setting
;		the ZCPR3 quiet flag also puts CONCAT in quiet mode, but
;		this option also toggles the meaning of the quiet flag.
;
;	S	Toggle disk space checking.  A configuration byte at 119h
;		decides whether CONCAT will default to checking for
;		sufficient space on the target disk before doing anything.
;		A non-zero value turns this feature off as the default.
;		This option toggles the meaning of the configuration byte.
;
; CONCAT requires an output file and at least one input file.  Actually,
; it can be used as a simple file-copy utility, but that's not its
; purpose.  The same filename may be given repeatedly in the input file
; list.  The equal sign separates the output file from the input files.
; Commas and/or spaces separate multiple input files.  While the equal
; sign is required, it may be separated from the filenames by one or
; more spaces.  A filename cannot begin with a slash unless it is
; preceded by a DU or DIR specification.
;
; If an error occurs, such as an input file not found, the incomplete
; output file is erased and the ZCPR3 error flag is set.  If another
; file has the same name as the output file, it will be renamed to
; filetype BAK.
;
; Append mode (option A) by-passes several of the program's safety
; features, so use it with caution.  For instance, no temporary file or
; BAK file is created.  The target (output) file must already exist.  On
; error, the output file is closed after appending any text that was
; read before the error occurred.  In this case the output file is not
; erased.
;
; For safety, remaining free space on the destination drive is checked
; and compared to the size of the source files (in K).  If there is
; insufficient space to complete the requested operation, CONCAT will
; abort with an error message.  Invalid or incompatible options also
; produce an error message.  (Options D and O are incompatible.)  If
; the quiet flag is set, only error messages will be displayed (unless
; the Q option is used to toggle the meaning of the flag).
;
; On error the error handler is invoked and the ZCPR3 error flag is set
; as follows:
;	 8	ambiguous or missing output or source filename
;	10	source or target file not found
;	11	disk or directory full (write error)
;	 4	all other errors
;
; Version 1.0 -- April 24, 1990 -- Gene Pizzetta
;	All known bugs fixed, including one that caused problems when
;	no alternate video strings were installed in the TCAP.  A special
;	thanks to Howard Goldstein for his efforts to uncover problems
;	and make sure this version works as intended.
;
; Version 0.9 -- April 8, 1990 -- Gene Pizzetta
;	Developmental version released for beta test only.  Added disk
;	space checking and S option to turn it off.  Displays actual
;	name of program in usage message.  Invokes error handler on
;	error.  ^C aborts during concatenation, but not during append.
;
; Version 0.8 -- March 8, 1990 -- Gene Pizzetta
;	Added D (date) option.  Date string prefix and suffix may be
;	configured (see documentation and code below).  Corrected a
;	minor bug which caused the temporary file not to be erased if
;	the first input file was not found.  Now senses size of TPA
;	and dynamically sets the size of the output buffer up to a
;	maximum of 32K.  Invalid options are no longer ignored, but
;	cause an error.
;
; Version 0.7 -- December 17, 1989 -- Gene Pizzetta
;	Added A (append) option, which by-passes several of CONCAT's
;	safety features.  A few more optimizations.
;
; Version 0.6 -- December 3, 1989 -- Gene Pizzetta
;	Minor changes in setting error flag.  Corrected serious error
;	in detecting top of memory, found by Howard Goldstein, who also
;	suggested several changes to make the code more efficient.
;	Thanks, Howard.
;
; Version 0.5 -- November 25, 1989 -- Gene Pizzetta
;	Added Q (quiet) option and error flag support.  Fixed parser
;	bug that allowed a null output filename.  Now closes output
;	file on error before erasing it.  Tightened code.
;
; Version 0.4 -- November 12, 1989 -- Gene Pizzetta
;	Added large output buffer.  Corrected error in parsing filespec
;	in current user.  Relaxed command line syntax: commas no longer
;	required.  Now obeys quiet flag.
;
; Version 0.3 -- September 19, 1989 -- Gene Pizzetta
;	First preliminary release.
;
; To report bugs or make suggestions:
;				Gene Pizzetta
;				481 Revere Street
;				Revere, MA 02151
;
;				Newton Centre Z-Node:  (617) 965-7259
;				GEnie:  E.Pizzetta
;				Voice:  (617) 284-0891
;
; Re-assembly requires RMAC or SLRMAC and SYSLIB, Version 4.  With RMAC,
; Z80.LIB will also be needed.  
;
Bdos	equ	05h
CpmDma	equ	80h
;
; Bdos functions . . .
;
FRead	equ	20
FWrite	equ	21
CurDsk	equ	25
SetDma	equ	26
CurUsr	equ	32
;
CtrlC	equ	03h		; control C
LF	equ	0Ah		; linefeed
CR	equ	0Dh		; carriage return
CpmEOF	equ	1Ah		; end-of-file (^Z)
;
	MACLIB	Z80		; extended Intel mnemonics
;
; Following routines are from DSLIB, VLIB, Z3LIB, and SYSLIB, Version 4
;
	ext	f$exist,f$open,f$mopen,f$rename,f$delete,f$close
	ext	logud,epstr,pfn2,crlf,cout,pafdc,initfcb,codend
	ext	z3vinit,zfname,stndout,stndend,getquiet,gzmtop
	ext	puter2,f$appl,timini,rclock,mafdc,bcd2bin,phlfdc
	ext	inverror,getefcb,dparams,dfree,getfs1,condin
;
	jmp	Start
;
	db	'Z3ENV'
	db	1
Z3EAdr:	dw	0FE00h		; address of environment descriptor
;
	db	'QUIET>'
QtFlag:	db	0		; 0 defaults to "noisy" mode
				; ..non-zero defaults to quiet mode
;
	db	'CHKSPC>'
SpFlag:	db	0		; 0 defaults to checking disk space
				; ..non-zero defaults to not checking
;
	db	'PREFIX>'
PrtTm1:	db	CR,LF,'--- [ ',0,0		; date string prefix
	db	0,0,0,0,0,0,0,0,0,0
	db	0,0,0,0,0,0,0,0,0,0
	db	0				; must be null terminated
;
	db	'SUFFIX>'
PrtTm3:	db	' ] ---',CR,LF,CR,LF		; date string suffix
	db	0,0,0,0,0,0,0,0,0,0
	db	0,0,0,0,0,0,0,0,0,0
	db	0				; must be null terminated
;
; Messages . . .
;
MsgUse:	db	'CONCAT    Version '
	db	Vers/10+'0','.',Vers mod 10+'0',SubVers,CR,LF
	db	'Usage:',CR,LF,'   ',0
MsgNam:	db	'CONCAT',0
MsgUs1:	db	' {dir:}outfile = {dir:}infile {{dir:}infile {...}}'
	db	' {/options}',CR,LF
	db	'Concatenates infiles to outfile.',CR,LF
	db	'Options:',CR,LF
	db	'   A   append to existing file',CR,LF
	db	'   D   insert system date and time',CR,LF
	db	'   O   object files, ignore ^Z',CR,LF
	db	'   Q   toggle quiet mode ',0
MsgUs2:	db	CR,LF
	db	'   S   toggle disk space checking ',0
MsgUon:	db	'on',0
MsgUof:	db	'off',0
MsgWrt:	db	'Writing to ',0
MsgApd:	db	'Appending to ',0
MsgRd:	db	'  Reading from ',0
MsgFSp:	db	'Space free ',0
MsgNds:	db	', needed ',0
MsgUAb:	db	'User aborted.',0
MsgNIG:	db	'No source file given.',0
MsgMem:	db	'Not enough memory!',0
MsgFNF:	db	' file not found.',0
MsgNSp:	db	'Insufficient disk space!',0
MsgFul:	db	'Output file is full.',0
MsgNOG:	db	'No output file given.',0
MsgBdO:	db	'Invalid or incompatible options.',0
MsgNCk:	db	'No clock or bad clock.',0
MsgREr:	db	'Read error.',0
MsgWEr:	db	'Disk full!',0
MsgCEr:	db	'Error closing file.',0
MsgAmb:	db	'Ambiguous filenames not allowed.',0
MsgDlm:	db	'Invalid command line: "=" expected.',0
MsgDne:	db	'Done!',0
;
Start:	lhld	Z3EAdr		; set up environment
	call	z3vinit
	sspd	OldStk		; save old stack pointer
	call	gzmtop		; get top of memory
	shld	MemTop		; store it
	sphl			; ..and setup new stack
;
	call	codend		; set buffer addresses
	shld	IWork
	lxi	d,128		; add 1 sector for output buffer address
	dad	d
	shld	OWork
	dad	d		; add another sector for stack
	xchg			; put buffer address in DE
	lhld	MemTop		; get top of memory
	ora	a		; reset the carry flag
	dsbc	de		; subtract
	jrnc	GotMem		; we've got enough memory (maybe)
NoMem:	mvi	a,4		; say not enough memory
	lxi	h,MsgMem
	jmp	ErExit
;
GotMem:	lxi	d,128		; put divisor in DE
	call	UDiv16		; ..and divide work space into sectors
	sub	a
	cmp	h		; maximum memory?
	jrnz	MaxMem		; (yes)
	cmp	l		; at 1 sector?
	jrz	NoMem		; (no)
	mov	a,l		; use number of sectors in L
	dcr	a		; ..less 1
	sta	BufSiz
	jr	InitOp
;
MaxMem:	mvi	a,255		; set output buffer size
	sta	BufSiz
;
InitOp:	sub	a		; initialize option flags
	mvi	b,GetFlg-OpAFlg
	lxi	h,OpAFlg
InitLp:	mov	m,a
	inx	h
	djnz	InitLp
	call	getquiet	; is ZCPR quiet flag set?
	jrnz	SetZQt		; (yes)
	lda	QtFlag		; no, get quiet config byte
SetZQt:	sta	OpQFlg		; ..and store in Q option flag
	lda	SpFlag		; check space flag
	sta	OpSFlg		; ..and store it
	call	GetDfD		; get and store default disk and user
	lda	CpmDma		; see if there's a tail
	ora	a
	jz	OptH		; (no)
;
GtTail:	mov	c,a		; move command tail to storage
	inr	c
	mvi	b,0
	lxi	h,CpmDma+1
	lxi	d,CTail
	ldir
;
	call	GetOpt		; get options, if any
	lxi	h,CTail		; get output filename from tail
	call	EatSpc		; eat any spaces
	ora	a		; is it NUL?
	jz	OptH		; (yes, no filename)
	cpi	'/'		; is it a slash?
	jrz	NoOFl		; (yes, no filename)
	cpi	'='		; is it an equal sign?
	jrnz	GtOFl		; (no)
NoOFl:	mvi	a,8		; set error flag
	lxi	h,MsgNOG
	jmp	ErExit
;
GtOFl:	lxi	d,OutFcb	; ..and put it in FCB
	call	zfname
	jrz	CkDelm		; (okay, so far)
	mvi	a,8		; set error flag
	lxi	h,MsgAmb	; it's ambiguous
	jmp	ErExit
;
CkDelm:	lda	FcbOFn		; make sure there's a filename
	cpi	'!'
	jrc	NoOFl		; (there's not)
	call	EatSpc
	mov	a,m
	cpi	'='		; equal sign after filename?
	jrz	GtOUsr		; (yes)
	mvi	a,4		; set error flag
	lxi	h,MsgDlm
	jmp	ErExit
;
GtOUsr:	inx	h		; get past delimiter
	shld	TailPt		; save command tail pointer
	lda	OpAFlg		; check for append mode
	ora	a
	jrnz	SkpTmp		; (yes, no temporary file)
	lxi	h,FcbOFn
	lxi	d,OutFil
	lxi	b,11
	ldir
	lxi	h,TmpTyp
	lxi	d,FcbOFt
	lxi	b,3
	ldir
SkpTmp:	lda	OutFcb		; get drive (A=1)
	ora	a		; is there one?
	jrnz	GtOUs1		; (yes)
	lda	DftDsk		; no, get default
GtOUs1:	dcr	a		; make A=0
	sta	OutDrv		; ..and store it
	lda	OutFcb+13	; get user
	sta	OutUsr		; ..and store it
	call	ChkSpc		; check disk space
	call	OpnOFl		; open output file
	call	CkAbrt		; check for user abort
	lda	OpQFlg		; quiet option?
	ora	a
	jrnz	Skip1		; (yes, don't print anything)
	lda	OpAFlg		; append mode?
	ora	a
	jrz	WrtMsg		; (no)
	lxi	d,FcbOFn	; print name of append file
	lxi	h,MsgApd
	jr	WrtMs1
WrtMsg:	lxi	d,OutFil	; print name of output file
	lxi	h,MsgWrt
WrtMs1:	call	epstr
	lda	OutDrv
	mov	b,a
	lda	OutUsr
	mov	c,a
	call	PrtFn
;
Skip1:	lda	OpDFlg		; are we inserting the date?
	ora	a
	cnz	PutDat		; (yes, go do it)
;
	call	SetIFl		; get first input file
	jrnz	GotIFl
NoIFl:	mvi	a,8		; set error flag
	lxi	h,MsgNIG
	jmp	SAbort
;
GotIFl:	call	CkAbrt		; check for user abort
	call	RdLoop		; read and write files
;
CkMore:	call	ClsIFl		; close input file
	call	CkAbrt
	call	SetIFl		; set up next input file
	jrz	NoMore
	call	RdLoop		; read and write files
	jr	CkMore
;
NoMore:	call	ClsOFl		; close output file
	lda	OpAFlg		; append mode?
	ora	a
	jrnz	Finish		; (yes, skip renaming)
	lxi	h,OutTyp	; move real filetype into FCB
	lxi	d,FcbOFt
	lxi	b,3
	ldir
	lxi	d,OutFcb
	call	initfcb
	call	f$exist		; see if XXX already exists
	jrz	SkpBak		; (it doesn't)
	lxi	h,BakTyp
	lxi	d,FcbOFt
	lxi	b,3
	ldir
	lxi	d,OutFcb	; point to existing BAK name
	call	f$delete	; erase any existing file
	lxi	h,FcbOFn
	lxi	d,FcbOFn+12
	lxi	b,11
	ldir
	lxi	h,OutFil
	lxi	d,FcbOFn
	lxi	b,11
	ldir
	lxi	d,OutFcb	; point to old XXX name
	lxi	h,OutFcb+12	; point to new BAK name
	call	f$rename	; ..and rename file
SkpBak:	lxi	h,TmpTyp	; rename temporary $$$ file
	lxi	d,FcbOFt	; ..to output filename
	lxi	b,3
	ldir
	lxi	h,OutFil
	lxi	d,FcbOFn+12
	lxi	b,11
	ldir
	lxi	h,OutFcb+12	; point to new XXX name
	lxi	d,OutFcb	; point to old $$$ name
	call	f$rename
;
Finish:	lda	OpQFlg		; quiet option?
	ora	a
	mvi	a,0		; reset error flag
	jrnz	Exit		; (yes)
	lxi	h,MsgDne
ErExit:	call	epstr		; print message
Exit:	call	puter2		; set error code
	mov	b,a		; put error code in B
	ora	a
	cnz	inverror	; call error handler
	lspd	OldStk		; restore old stack pointer
	ret			; ..and return to CCP
;
SAbort:	mov	b,a		; save error code
	lda	OpSFlg		; space check mode?
	ora	a
	mov	a,b		; get back error code
	jz	ErExit		; (yes)
;
Abort:	push	psw		; save error code
	push	h		; save message
	call	ClsOut		; close output file
	lda	OpAFlg		; append mode?
	ora	a
	jrnz	Abort1		; (yes, skip erase)
	call	f$delete	; erase output file
Abort1:	pop	h		; get back message
	pop	psw
	jmp	ErExit
;
; Subroutines . . .
;
; SetIFl -- Get input filename and set up for input.  Z flag set if no
; more files.
;
SetIFl:	call	GetIFl		; search for next input file
	rz			; (none)
	push	psw		; save flags
	call	OpnIFl		; open file
	lda	OpQFlg		; quiet mode?
	ora	a
	jrnz	SetIF2		; (yes, don't print anything)
	lxi	h,MsgRd		; print filename we're reading
	call	epstr
	lda	InDrv
	mov	b,a
	lda	InUsr
	mov	c,a
	lxi	d,FcbIFn
	call	PrtFn
SetIF2:	pop	psw
	ret
;
; GetIFl -- Get next input filename from command line
;
GetIFl:	lda	DftUsr		; set default user for parser
	mov	e,a
	mvi	c,CurUsr
	call	Bdos
	lhld	TailPt		; recover command tail pointer
	call	EatSpc
	cpi	','		; got comma?
	jrnz	GetIF1		; (no)
	inx	h		; get past it
	call	EatSpc
GetIF1:	ora	a
	rz			; (no more files)
	cpi	'/'
	rz			; (no more files)
	call	IniIFl		; initialize FCB
	ret
;
; IniIFl -- initialize input file control block
;
IniIFl:	lxi	d,InpFcb	; point to input FCB
	call	zfname		; ..and parse filespec
	jrz	GtIUsr		; (still okay)
	lda	OpSFlg		; disk space mode?
	ora	a
	jrnz	IniIF2		; (no)
	call	crlf
IniIF2:	mvi	a,8		; set error flag
	lxi	h,MsgAmb	; it's ambiguous
	jmp	SAbort
;
GtIUsr:	shld	TailPt		; save command tail pointer
	lda	InpFcb		; get drive (A=1)
	ora	a		; is there one?
	jrnz	GtIUs1		; (yes)
	lda	DftDsk		; no, get default
GtIUs1:	dcr	a		; make A=0
	sta	InDrv		; ..and store it
	lda	InpFcb+13	; get user
	sta	InUsr		; ..and store it
	inr	a		; reset Z flag
	ret
;
; OpnIFl -- open input file
;
OpnIFl:	mvi	a,128		; initialize pointer
	sta	GetPtr
	sub	a		; initialize end-of-file flag
	sta	GetFlg
	lxi	d,InpFcb
	call	initfcb
	call	InDU		; set drive/user for input
	call	f$open
	rz			; (all okay)
	lda	OpAFlg		; append mode?
	ora	a
	cnz	ClsOFl		; (yes, write buffer)
NoSrc:	lxi	d,FcbIFn	; print filename not found
	call	pfn2
	mvi	a,10		; set error flag
	lxi	h,MsgFNF	; open error
	jmp	SAbort
;
; OpnOFl -- open output file
;
OpnOFl:	sub	a		; initialize counters
	sta	PutCtr
	sta	PutSec
	lhld	OWork		; initialize buffer pointer
	shld	PutPtr
	lxi	d,OutFcb
	call	initfcb		; initialize FCB
	call	OutDU
	lda	OpAFlg		; append mode?
	ora	a
	jrnz	OpnApd		; (yes)
	call	f$delete	; erase any existing file
	call	f$mopen
	rz			; (okay)
	mvi	a,11		; set error flag
	lxi	h,MsgWEr	; open error
	jmp	ErExit
;
OpnApd:	push	d		; save FCB pointer
	lded	OWork		; put DMA address in DE
	mvi	c,SetDMA	; ..and set DMA address
	call	Bdos
	pop	d		; recover FCB address
	call	f$appl		; read append file
	ora	a		; any errors?
	jrnz	ApdErr		; (yes)
	lda	OpOFlg		; object file mode?
	ora	a
	jrnz	ApdObj		; (yes)
	lhld	PutPtr		; point to output buffer
	lda	PutCtr		; get counter to B
	mov	b,a
ApdLp:	mov	a,m		; get character
	cpi	CpmEof		; end of file?
	jrz	ApdEnd		; (end)
	inx	h		; increment pointer
	inr	b		; increment counter
	mov	a,b
	cpi	128		; end of sector?
	jrz	ApdObj		; (yes, no ^Z)
	jr	ApdLp		; continue
;
ApdEnd:	mov	a,b		; store current counter position
	sta	PutCtr
	ret
;
ApdObj:	mvi	a,128		; set counter for full sector
	sta	PutCtr
	ret
;
ApdErr:	cpi	3		; file empty?
	rz			; (yes, but who cares?)
	cpi	2		; file full?
	jrnz	ApdEr1		; (no)
	mvi	a,4
	lxi	h,MsgFul
	jmp	ErExit
;
ApdEr1:	lxi	d,FcbOFn	; print filename
	call	pfn2
	mvi	a,10		; must be file not found
	lxi	h,MsgFNF
	jmp	ErExit
;
; RdLoop -- reads and writes until end of file
;
RdLoop:	call	FGetC		; get a character
	jc	RdErr		; (read error)
	rz			; (end of file)
	cpi	CpmEof		; end of file?
	cz	ChkEof		; (yes, check mode)
	rz			; (yes)
	call	FPutC		; write character
	jc	WrtErr		; (write error)
	jr	RdLoop
;
RdErr:	mvi	a,4		; set error flag
	lxi	h,MsgREr	; we have an input read error
	jmp	Abort
;
WrtErr:	mvi	a,11		; set error flag
	lxi	h,MsgWEr	; we have an output write error
	jmp	Abort
;
; ChkEof -- checks for Option O and, if so, ignores end-of-file character
;
ChkEof:	mov	b,a		; save character in B
	lda	OpOFlg		; get object flag
	ora	a
	mov	a,b		; get character back in A
	ret
;
; ClsIFl -- close input file
;
ClsIFl:	call	InDU		; close input file
	lxi	d,InpFcb
	call	f$close
	rz			; (okay)
	mvi	a,4		; set error flag
	lxi	h,MsgCEr
	jmp	Abort
;
; ClsOFl -- closes output file
;
ClsOFl:	call	OutDU
	lda	OpOFlg		; check option O flag
	ora	a
	jrnz	WrLst		; (object file transfer, skip EOF)
	mvi	a,CpmEof	; put end-of-file character
	call	FPutC
	lda	PutCtr		; check pointer
	ora	a
	jz	WrLst		; (sector finished)
	mov	b,a
	mvi	a,128		; fill rest of sector with ^Z
	sub	b
	mov	b,a
FillZ:	mvi	a,CpmEof
	push	b
	call	FPutC
	pop	b
	djnz	FillZ
	jr	WrLst
;
WrLst:	lded	OWork		; get beginning buffer address to DE
	lxi	h,PutPtr	; HL -> buffer pointer
	mov	a,e		; is pointer at zero?
	cmp	m
	jrnz	WrLst2		; (no)
	mov	a,d
	inx	h
	cmp	m
	jrnz	WrLst2		; (no)
	lda	PutCtr		; is counter at zero?
	ora	a
	jrnz	WrLst2		; (no)
	jr	ClsOut		; nothing to write, so close it
;
WrLst2:	call	FWrtF		; write what's left
	ora	a		; check for error
	jnz	WrtErr		; (yes, abort)
;
ClsOut:	call	OutDU		; close output file
	lxi	d,OutFcb
	call	f$close
	rz			; (okay)
	mvi	a,4		; set error flag
	lxi	h,MsgCEr
	jmp	ErExit
;
; GetDfD -- gets default user and stores it; gets default disk (A=0)
; and stores it (A=1)
;
GetDfD:	mvi	e,0FFh		; get current user
	mvi	c,CurUsr
	call	Bdos
	sta	DftUsr
	mvi	c,CurDsk	; get default disk
	call	Bdos
	inr	a		; make it fcb compatible
	sta	DftDsk
	ret
;
; PrtFn -- Prints drive/user and filename on console
;
PrtFn:	call	stndout
	mov	a,b		; get drive
	adi	'A'		; make it printable
	call	cout		; ..and print it
	mov	a,c		; get user
	call	pafdc		; ..and print it
	mvi	a,':'
	call	cout
	call	pfn2		; print filename
	call	stndend
	call	crlf
	ret
;
; EatSpc -- gobbles up spaces
;
EatSpc:	mov	a,m
	cpi	' '		; is it a space?
	inx	h
	jrz	EatSpc		; (yes)
	dcx	h
	ret
;
; OutDU -- sets default drive and user for output file
;
OutDU:	lda	OutUsr
	mov	c,a
	lda	OutDrv
	mov	b,a
	call	logud
	ret
;
; InDU -- sets default drive and user for input file
;
InDU:	lda	InUsr
	mov	c,a
	lda	InDrv
	mov	b,a
	call	logud
	ret
;
; FGetC -- returns character from file.  Assumes file has been
; successfully opened.  Returns character or ^Z (end-of-file) in
; A.  Zero set (Z) on end of file.  Carry set (C) if error.
;
FGetC:	lda	GetFlg		; check end-of-file flag
	ora	a
	jrnz	GetEof		; (yes)
	lda	GetPtr		; get pointer
	cpi	128		; done with buffer?
	jrc	GetChr		; (no, get a character)
	call	CkAbrt		; check for user abort
	lded	IWork
	mvi	c,SetDMA	; set DMA address
	call	Bdos
	call	InDU		; set DU
	lxi	d,InpFcb
	mvi	c,FRead		; read more file
	call	Bdos
	cpi	1		; return code?
	jrz	GetEof		; (end of file)
	jrnc	GetErr		; (a problem)
	sta	GetPtr		; put 0 in pointer
;
GetChr:	lhld	IWork		; point to DMA buffer
	mov	e,a		; put pointer in DE
	mvi	d,0
	dad	d		; add it to HL
	mov	a,m		; get next character
	lxi	h,GetPtr	; increment pointer
	inr	m
	stc
	cmc			; clear carry
	ret
;
GetEof:	mvi	a,CpmEof
	sta	GetFlg		; set end-of-file flag
	stc
	cmc			; clear carry
	ret
;
GetErr:	mvi	a,CpmEof
	sta	GetFlg
	stc			; set carry
	ret
;
; FPutC -- Writes character to file.  Assumes file has been successfully
; opened.  Expects character in A.  Returns carry set (C) on error.
;
FPutC:	mov	c,a		; save character in C
	lda	PutCtr		; get counter
	cpi	128		; buffer full?
	jrc	PutChr		; (no, so do it)
	push	b		; the character is threatened from all sides
	lda	BufSiz		; get buffer size
	mov	b,a		; ..and put it in B
	lda	PutSec		; get sector count
	cmp	b		; end of buffer?
	jrz	FPutC2		; (yes, we need to write it)
	inr	a		; increment sector count
	sta	PutSec		; ..and store it
	lhld	PutPtr		; get current sector pointer
	lxi	d,128		; ..add 128 to it
	dad	d
	shld	PutPtr		; ..and store it
	xra	a		; make A = 0
	jr	FPutC3
;
FPutC2:	call	FWrtF		; write buffer to disk
	push	psw
	lhld	OWork		; reset buffer pointer
	shld	PutPtr
	xra	a		; reset sector counter
	sta	PutSec
	pop	psw
;
FPutC3:	pop	b		; get back output character
	ora	a		; return code?
	jrnz	PutErr		; (problem)
	sta	PutCtr		; reset counter to 0
;
PutChr:	lhld	PutPtr		; point to current DMA buffer
	mov	e,a		; move counter to DE
	mvi	d,0
	dad	d		; ..and add it to HL
	mov	m,c		; write character
	lda	PutCtr
	inr	a		; increment counter
	sta	PutCtr
	sub	a		; clear carry
	ret
;
PutErr:	stc			; set carry
	ret
;
; FWrtF -- write output buffer to disk
;
FWrtF:	lda	PutSec		; get buffer sector count
	mov	b,a		; put it in B
	lded	OWork		; point to beginning of buffer
FWrtF2:	push	b		; save sector count
	push	d		; save DMA address
	call	WrtSec		; write the sector
	pop	h		; DMA address recovered in HL
	pop	b		; get back sector count
	ora	a		; write error?
	rnz			; (yes)
	cmp	b		; end of buffer?
	rz			; (yes)
	dcr	b		; decrement sector count
	lxi	d,128		; increment DMA address
	dad	d
	xchg
	jr	FWrtF2
;
WrtSec:	mvi	c,SetDma	; set DMA address
	call	Bdos
	call	OutDu		; set drive and user
	lxi	d,OutFcb	; ..and write sector
	mvi	c,FWrite
	call	Bdos
	ret
;
; PutDat --  Sends date and time string to output file
;
PutDat:	lxi	h,PrtTm1	; send the prefix
	call	PrtDat
	lxi	h,PrtTm2	; send the date and time
	call	PrtDat
	lxi	h,PrtTm3	; send the suffix
	call	PrtDat
	ret
;
PrtDat:	mov	a,m		; get character
	cpi	0		; is it null?
	rz			; (yes, we're finished)
	push	h
	call	FPutC		; send character to outfile
	pop	h
	jc	WrtErr
	inx	h
	jr	PrtDat
;
; ChkSpc -- checks free space on target drive and compares it with the
; total of the filesizes of the input files.  Aborts if space is
; insufficient.
;
ChkSpc:	lda	OpSFlg		; check flag
	ora	a
	rnz			; (no, don't check)
;
	lhld	TailPt		; save pointer
	push	h
	call	OutDu		; select output drive
	call	dparams
	call	dfree		; get free space
	xchg			; ..and store it
	shld	DskSpc
	lda	OpQFlg		; quiet mode?
	ora	a
	jrnz	Skip2		; (yes, no messages)
	lxi	h,MsgFSp	; say how much
	call	epstr
	lhld	DskSpc
	call	phlfdc
	mvi	a,'k'
	call	cout
Skip2:	call	GetIFl		; get first source
	jz	NotGvn		; (none)
	call	InDU
	lxi	d,InpFcb
	call	f$exist
	jz	NoFile
	call	getfs1		; get file size
	call	Div8		; convert to kilobytes
	shld	FilSiz		; ..store it
	xchg
	shld	FilRem		; ..store remainder
ChkSp1:	call	GetIFl		; check for more input files
	jrz	ChkDne		; (none)
	call	InDU
	lxi	d,InpFcb
	call	F$exist
	jrz	NoFile
	call	getfs1		; get file size
	call	Div8		; convert to kilobytes
	push	de		; save remainder
	xchg
	lhld	FilSiz		; add to total file size
	dad	d
	shld	FilSiz
	lhld	FilRem		; add remainder
	pop	de
	dad	d
	shld	FilRem
	jr	ChkSp1
;
ChkDne:	lhld	FilRem		; convert remainder to kilobytes
	lda	OpDFlg		; check date stamp option
	ora	a
	jrz	ChkDn1		; (nope)
	inx	h		; yep, add another record
ChkDn1:	call	Div8
	xra	a
	cmp	e		; check for remainder
	jrz	ChkDn2		; (none)
	inx	h		; add one more K
ChkDn2:	xchg			; remainder in DE
	lhld	FilSiz		; add to file size
	dad	d
	shld	FilSiz
	lda	OpQFlg		; quiet mode?
	ora	a
	jrnz	Skip3		; (yes, no messages)
	xchg			; save file size in DE
	lxi	h,MsgNds
	call	epstr
	xchg			; get file size back in HL
	call	phlfdc
	mvi	a,'k'
	call	cout
	call	crlf
Skip3:	xchg			; put total file size in DE
	lhld	DskSpc		; get free space in HL
	ora	a		; reset carry flag
	dsbc	de		; subtract DE from HL
	jrc	NoSpc		; (not enough disk space)
	lda	DftDsk		; relog default DU
	dcr	a
	mov	b,a
	lda	DftUsr
	mov	c,a
	call	logud
	pop	h		; restore pointer
	shld	TailPt
	ret
;
NotGvn:	call	crlf
	jmp	NoIFl
;
NoFile:	call	crlf
	jmp	NoSrc
;
NoSpc:	mvi	a,11		; set error flag
	lxi	h,MsgNSp	; say not ehough disk space
	jmp	ErExit
;
; GetOpt -- checks command tail for user supplied options and sets
; appropriate option flags.  Invalid options are ignored.
;
GetOpt:	lxi	h,CTail		; point to command tail
	lda	CpmDma		; anything there?
	ora	a
	rz			; (no)
	mov	b,a		; yes, put number of chars in B
ScnDLp:	mov	a,m		; get character
	cpi	'/'		; delimiter?
	jz	ScnOpt		; (yes)
	mov	d,a		; save character
ScnDL2:	inx	h		; no, keep looking
	djnz	ScnDLp
	ret			; (none found, return)
;
ScnOpt:	push	psw		; save current character
	mov	a,d		; get back previous character
	pop	d		; put current character in D
	cpi	' '		; was previous char a space?
	jnz	ScnDL2		; (no)
	jmp	ScnOp2
;
ScnOLp:	call	ScnTbl
	xchg			; point back to options
ScnOp2:	inx	h
	djnz	ScnOLp		; loop through options
	lda	OpDFlg		; check for incompatible options
	ora	a
	rz			; (no date option)
	lda	OpOFlg
	ora	a
	rz			; (no object mode option)
	mvi	a,4
	lxi	h,MsgBdO	; bad options
	jmp	ErExit
;
ScnTbl:	mov	c,m		; put option in C
	lxi	d,OptTbl	; point DE to option table
ScnTLp:	ldax	d		; get table option
	ora	a		; end of table?
	jz	NoMat		; (yes, no match)
	inx	d		; no, keep looking
	cmp	c		; match?
	jz	TMatch		; (yes)
	inx	d		; move pointer to next entry
	inx	d
	jmp	ScnTLp		; ..and keep looking
;
NoMat:	xchg			; no match
	mov	a,c		; get back option
	cpi	' '		; was it a space?
	rz			; that's okay
	mvi	a,4		; set error flag
	lxi	h,MsgBdO	; say bad option
	jmp	ErExit
;
TMatch:	push	h		; save option pointer
	ldax	d		; put address from table into HL
	mov	l,a
	inx	d
	ldax	d
	mov	h,a
	pop	d		; recover option pointer in DE
	mvi	a,1		; set option flag by jumping to
	pchl			; ..table routine and returning
;
; OptTbl -- Option Jump Table
;
OptTbl:	db	'/'		; / = usage message
	dw	OptH
	db	'A'		; A = append mode
	dw	OptA
	db	'D'		; D = datestamp file
	dw	OptD
	db	'O'		; O = object file transfer
	dw	OptO
	db	'Q'		; Q = toggle configured quiet flag
	dw	OptQ
	db	'S'		; S = toggle disk space checking
	dw	OptS
	db	0		; end of option jump table
;
; Option setting routines
;
OptH:	lxi	h,MsgUse	; print usage message
	call	epstr
	call	ComNam		; print name we're called by, if possible
	lxi	h,MsgUs1
	call	epstr
	lda	OpQFlg		; check quiet mode
	ora	a
	jrz	OptH2		; (off)
	lxi	h,MsgUof
	jmp	OptH3
OptH2:	lxi	h,MsgUon
OptH3:	call	epstr
	lxi	h,MsgUs2	; S option usage
	call	epstr
	lda	OpSFlg		; check space check mode
	ora	a
	mvi	a,0
	jrz	OptH4		; (on)
	lxi	h,MsgUon
	jmp	ErExit
;
OptH4:	lxi	h,MsgUof
	jmp	ErExit
;
OptA:	sta	OpAFlg		; just set the flag
	ret
;
OptD:	sta	OpDFlg		; set flag
	call	timini		; initialize clock routine
	jrz	OpDEr		; (error, no clock)
	push	b
	push	d
	lxi	h,TimStr	; point to BCD time string
	call	rclock		; read clock
	jrnz	OpDEr		; (error, bad clock)
	lxi	h,TimStM	; create ASCII time and date string
	lxi	d,PrtTm2
	mov	a,m		; ..month
	call	bcd2bin
	call	mafdc
	inx	h
	mvi	a,'/'
	stax	d
	inx	d
	mov	a,m		; ..day
	call	bcd2bin
	cpi	10		; leading zero?
	jrnc	NoZro1		; (no)
	mov	b,a		; save character
	mvi	a,'0'
	stax	d		; put zero
	inx	d
	mov	a,b		; recover character
NoZro1:	call	mafdc
	mvi	a,'/'
	stax	d
	inx	d
	lxi	h,TimStr
	mov	a,m		; ..year
	call	bcd2bin
	call	mafdc
	mvi	a,' '
	stax	d
	inx	d
	stax	d
	inx	d
	lxi	h,TimStH
	mov	a,m		; ..hour
	call	bcd2bin
	call	mafdc
	inx	h
	mvi	a,':'
	stax	d
	inx	d
	mov	a,m		; ..minute
	call	bcd2bin
	cpi	10		; leading zero?
	jrnc	NoZro2		; (no)
	mov	b,a
	mvi	a,'0'
	stax	d
	inx	d
	mov	a,b
NoZro2:	call	mafdc
	mvi	a,0
	stax	d
	pop	d
	pop	b
	ret
;
OpDEr:	mvi	a,4		; no clock
	lxi	h,MsgNCk
	jmp	ErExit
;
OptO:	sta	OpOFlg		; just set the flag
	ret
;
OptQ:	lda	OpQFlg		; get Q flag
	ora	a
	jrz	OptQ2		; (not set)
	sub	a
	sta	OpQFlg		; zero it
	ret
OptQ2:	mvi	a,1
	sta	OpQFlg		; set it
	ret
;
OptS:	lda	OpSFlg		; get S flag
	ora	a
	jrz	OptS2		; (not set)
	sub	a
	sta	OpSFlg		; zero it
	ret
OptS2:	mvi	a,1
	sta	OpSFlg		; set it
	ret
;
; ComNam -- Print actual name by which this program was called, if available
; from external file control block.  Otherwise, use "CONCAT".
;
ComNam:	call	getefcb
	jrz	NoEFcb		; (no external fcb)
	mvi	b,8		; print filename
ComNLp:	inx	hl
	mov	a,m
	ani	7Fh
	cpi	' '
	cnz	cout
	djnz	ComNLp
	ret
;
NoEFcb:	lxi	h,MsgNam	; print default name
	call	epstr
	ret
;
; CkAbrt -- Check for user abort (^C).  Ignore if in Append mode.
;
CkAbrt:	lda	OpAFlg		; check append flag
	ora	a
	rnz			; (yes, return)
	call	condin		; do we have a key?
	rz			; (no)
	cpi	CtrlC		; is it ^C?
	rnz			; (no)
	mvi	a,4		; yes, abort this mess
	lxi	h,MsgUAb
	jmp	Abort
;
Div8:	push	psw		; save registers
	push	bc
	lxi	d,8		; divisor = 8
	call	UDiv16
	pop	bc
	pop	psw
	ret
;
; UDiv16 -- divide 2 unsigned 16-bit words and return a 16-bit unsigned
; quotient and remainder.
; Entry: L = low byte of dividend, H = high byte of dividend
; 	 E = low byte of divisor, D = high byte of divisor
; Exit:	 L = low byte of quotient, H = high byte of quotient
;	 E = low byte of remainder, D = high byte of remainder
;	 Carry reset if no errors, Carry set if divide-by-zero error
;		(and quotient = 0 and remainder = 0)
; Used:	 AF,BC,DE,HL
;
; check for division by zero
UDiv16:	mov	a,e
	ora	d
	jrnz	Divide		; branch if divisor is non-zero
	lxi	h,0		; divide by zero error
	mov	d,h
	mov	e,l
	stc			; set carry, invalid result
	ret
;
Divide:	mov	c,l		; C = low byte of dividend/quotient
	mov	a,h		; A = high byte of dividend/quotient
	lxi	h,0		; HL = remainder
	mvi	b,16		; 16 bits in dividend
	ora	a		; clear carry to start
; Shift next bit of quotient into bit 0 of dividend.  Shift next most
; significant bit of dividend into least significant bit of remainder.
; BC holds both dividend and quotient.  While we shift a bit from MSB
; of dividend, we shift next bit of quotient in from Carry.  HL holds
; remainder.
;
; do a 32-bit left shift, shifting Carry to C, C to A, A to L, L to H
DvLoop:	ralr	c		; carry (next bit of quotient) to bit 0
	ral			; shift remaining bytes
	ralr	l
	ralr	h		; clears carry since HL was 0
; If remainder is greater than or equal to divisor, next bit of quotient
; is 1.  This bit goes to Carry.
	push	h		; save current remainder
	dsbc	de		; subtract divisor from remainder
	cmc			; complement borrow so 1 indicates a
				; successful subtraction (this is next
				; bit of quotient)
	jrc	Drop		; jump if remainder is >= dividend
	xthl			; otherwise restore remainder
Drop:	inx	sp		; drop remainder from top of stack
	inx	sp
	djnz	DvLoop		; continue until all bits done
; shift last carry bit into quotient
	xchg			; de = remainder
	ralr	c		; carry to C
	mov	l,c		; L = low byte of quotient
	ral
	mov	h,a		; H = high byte of quotient
	ora	a		; clear carry, valid result
	ret
;
; Data storage . . .
;
OutFil:	db	'        '	; save original output filename here
OutTyp:	db	'   '
BakTyp:	db	'BAK'		; for BAK file
TmpTyp:	db	'$$$'		; for temporary filename
;
	DSEG
;
; Uninitialized storage . . .
;
InpFcb:	ds	1		; input file fcb
FcbIFn:	ds	8
FcbIFt:	ds	3
	ds	24
;
OutFcb:	ds	1		; output file fcb
FcbOFn:	ds	8
FcbOFt:	ds	3
	ds	24
;
OpAFlg:	ds	1		; option flags
OpDFlg:	ds	1
OpOFlg:	ds	1
OpQFlg:	ds	1
OpSFlg:	ds	1
PrtTm2:	ds	18		; ASCII date string
;
GetFlg:	ds	1		; FGetC end-of-file flag
GetPtr:	ds	1		; FGetC pointer
PutCtr:	ds	1		; FPutC counter
PutPtr:	ds	2		; FPutC pointer
PutSec:	ds	1		; FPutC sector counter
IWork:	ds	2		; input buffer address
OWork:	ds	2		; output buffer address
DftUsr:	ds	1		; default user area
DftDsk:	ds	1		; default drive
InDrv:	ds	1		; input file drive
InUsr:	ds	1		; input file user
OutDrv:	ds	1		; output file drive
OutUsr:	ds	1		; output file user
DskSpc:	ds	2		; disk free space
FilSiz:	ds	2		; total file size (kilobytes)
FilRem:	ds	2		; file size remainders (records)
BufSiz:	ds	1		; output buffer size
MemTop:	ds	2		; top of memory address
OldStk:	ds	2		; old stack pointer
TimStr:	ds	1		; time string storage
TimStM:	ds	2
TimStH:	ds	3
TailPt:	ds	2		; command tail index pointer
CTail:	ds	128		; command tail storage
;

	end