; CONCAT.MAC -- Version 0.3  -- September 19, 1989
;
; Concatenates two or more source files into a destination file,
; similar to PIP.  For ZCPR3 only.
;
; USAGE:
;
;	CONCAT {dir:}outfile={dir:}infile{,{dir:}infile{, ...}} {/option}
;
; Any file without a DU or DIR specification is assumed to be on
; the current drive/user.  Default is text mode, checking for a
; CP/M end-of-file character (^Z).  The only option at present is
; 'O', which puts CONCAT is object mode so ^Z's are ignored.
;
; 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 separate multiple input files.  While the equal sign
; and commas are required, they 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.  If another file has the same name as the
; output file, it will be renamed to filetype BAK.
;
; An invalid option will be ignored.
;
; To report bugs or make suggestions:
;				Gene Pizzetta
;				481 Revere Street
;				Revere, MA 02151
;
;				Newton Centre Z-Node:  (617) 965-7259
;				Lilliput Z-Node:  (312) 649-1730
;				Voice:  (617) 284-0891
;
; Re-assembly requires MAC or SLRMAC and SYSLIB, Version 4.  With MAC,
; Z80.LIB will also be needed.  
;
Bdos	equ	05h
MemTop	equ	Bdos+1
CpmDma	equ	80h
TPA	equ	100h
;
; Bdos functions . . .
;
FRead	equ	20
FWrite	equ	21
CurDsk	equ	25
SetDma	equ	26
;
LF	equ	0Ah
CR	equ	0Dh
CpmEOF	equ	1Ah
BufSiz	equ	1
;
	MACLIB	Z80
;
; Following routines are from VLIB, Z3LIB, and SYSLIB, Version 4
;
	ext	f$exist,f$open,f$mopen,f$rename,f$delete,f$close
	ext	logud,pstr,pfn2,crlf,cout,pafdc,initfcb
	ext	z3vinit,zfname,stndout,stndend
;
	jmp	Start
;
	db	'Z3ENV'
	db	1
Z3EAdr:	dw	0FE00h		; address of environment descriptor
;
; Messages . . .
;
MsgUse:	db	'CONCAT    Version 0.3',CR,LF
	db	'Usage:',CR,LF
	db	'   CONCAT {dir:}outfile={dir:}infile{,{dir:}infile{, ...}}'
	db	' {/option}',CR,LF
	db	'Concatenates infiles to outfile.',CR,LF
	db	'Option:',CR,LF
	db	'   O   object files, ignore ^Z',0
MsgWrt:	db	'Writing  ',0
MsgRd:	db	'  Reading  ',0
MsgNIG:	db	'No input file given.',0
MsgNIF:	db	'Input file not found.',0
MsgNOG:	db	'No output file given.',0
MsgNOF:	db	'Output file not found.',0
MsgNEr:	db	'Can''t erase existing file.',0
MsgREr:	db	'Input read error.',0
MsgWEr:	db	'Output write error.',0
MsgCIF:	db	'Error closing input file.',0
MsgCOF:	db	'Error closing output file.',0
MsgAmb:	db	'Ambiguous filename not allowed.',0
MsgDlm:	db	'Illegal command line.',0
MsgDne:	db	'Done!',0
;
Start:	sspd	OldStk		; save old stack pointer
	lhld	MemTop		; get top of memory
	mov	a,h		; move high byte to A
	sui	16		; preserve 4K for CCP and safety
	mov	h,a		; ..and put it back
	sphl
	lhld	Z3EAdr		; set up environment
	call	z3vinit
;
	call	GetDfD		; get and store default disk
	lda	CpmDma		; see if there's a tail
	ora	a
	jrnz	GtTail		; (yes)
	lxi	h,MsgUse	; no, tell them how to do it
	call	pstr
	jmp	Exit
;
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
	cpi	0		; is it NUL?
	jrz	NoOFl		; (no)
	cpi	'/'		; is it a slash?
	jrnz	GtOFl		; (no)
NoOFl:	lxi	h,MsgNOG
	call	pstr
	jmp	Exit
;
GtOFl:	lxi	d,OutFcb	; ..and put it in FCB
	call	zfname
	jrz	CkDelm		; (okay, so far)
	lxi	h,MsgAmb	; it's ambiguous
	call	pstr
	jmp	Exit
;
CkDelm:	call	EatSpc
	mov	a,m
	cpi	'='		; equal sign after filename?
	jrz	GtOUsr		; (yes)
	lxi	h,MsgDlm
	call	pstr
	jmp	Exit
;
GtOUsr:	inx	h		; get past delimiter
	shld	TailPt		; save command tail pointer
	lxi	h,FcbOFn
	lxi	d,OutFil
	lxi	b,11
	ldir
	lxi	h,TmpTyp
	lxi	d,FcbOFt
	lxi	b,3
	ldir
	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
;
	lhld	TailPt
	call	EatSpc
	cpi	0
	jrz	NoIFl
	cpi	'/'
	jrnz	GtIFl
NoIFl:	lxi	h,MsgNIG
	call	pstr
	jmp	Exit
;
GtIFl:	call	SetIFl		; set up input FCB
	call	OpnInp		; open input file
	call	OpnOut		; open output file
;
	lxi	h,MsgWrt
	call	pstr
	lda	OutDrv
	mov	b,a
	lda	OutUsr
	mov	c,a
	lxi	d,OutFil
	call	PrtFn
	lxi	h,MsgRd
	call	pstr
	lda	InDrv
	mov	b,a
	lda	InUsr
	mov	c,a
	lxi	d,FcbIFn
	call	PrtFn
;
	call	RdLoop		; read and write files
;
CkMore:	call	ClsIFl		; close input file
	lhld	TailPt		; any more input files?
	call	EatSpc
	cpi	','
	jrnz	NoMore		; (no)
	inx	h
	call	EatSpc
	cpi	0
	jrz	NoMore
	cpi	'/'
	jrz	NoMore
	call	SetIFl		; set up input FCB
	call	OpnInp		; open input file
	lxi	h,MsgRd
	call	pstr
	lda	InDrv
	mov	b,a
	lda	InUsr
	mov	c,a
	lxi	d,FcbIFn
	call	PrtFn
	call	RdLoop		; read and write files
	jr	CkMore
;
Abort:	call	OutDU
	lxi	d,OutFcb
	call	f$exist		; does an output file exist?
	jrz	Abort1		; (no)
	call	OutDU
	lxi	d,OutFcb
	call	f$delete	; yes, erase it
Abort1:	jmp	Exit
;
NoMore:	call	ClsOFl		; close output file
	lxi	h,OutTyp	; move real filetype into FCB
	lxi	d,FcbOFt
	lxi	b,3
	ldir
	lxi	d,OutFcb
	call	initfcb
	call	OutDU
	lxi	d,OutFcb
	call	f$exist		; see if XXX already exists
	jrz	SkpBak		; (it doesn't)
	lxi	h,BakTyp
	lxi	d,FcbOFt
	lxi	b,3
	ldir
	call	OutDU
	lxi	d,OutFcb	; point to existing BAK name
	call	f$delete	; erase any existing file
	jrz	DelSuc		; (delete successful)
	lxi	h,MsgNEr
	call	pstr
	jmp	Abort
;
DelSuc:	lxi	h,FcbOFn
	lxi	d,FcbOFn+12
	lxi	b,11
	ldir
	lxi	h,OutFil
	lxi	d,FcbOFn
	lxi	b,11
	ldir
	call	OutDU
	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
	call	OutDU
	lxi	h,OutFcb+12	; point to new XXX name
	lxi	d,OutFcb	; point to old $$$ name
	call	f$rename
;
Finish:	lxi	h,MsgDne
	call	pstr
Exit:	lspd	OldStk		; restore old stack pointer
	ret
;
; Subroutines . . .
;
; SetIFl -- set up input file control block
;
SetIFl:	lxi	d,InpFcb	; point to input FCB
	call	zfname		; ..and parse filespec
	jrz	GtIUsr		; (still okay)
	lxi	h,MsgAmb	; it's ambiguous
	call	pstr
	jmp	Abort
;
GtIUsr:	shld	TailPt		; save command tail pointer
	lda	InpFcb		; get driv (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
	ret
;
; OpnInp -- open input file
;
OpnInp:	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
	lxi	d,InpFcb		; open input file
	call	f$open
	rz			; (all okay)
	lxi	h,MsgNIF	; open error
	call	pstr
	jmp	Abort
;
; OpnOut -- open output file
;
OpnOut:	sub	a		; initialize pointer
	sta	PutPtr
	lxi	d,OutFcb
	call	initfcb		; initialize FCB
	call	OutDU
	lxi	d,OutFcb	; open output file
	call	f$exist		; does it already exist?
	jrz	OpnOu1		; (no)
	lxi	d,OutFcb
	call	f$delete	; yes, delete it
	jrz	OpnOu1
	lxi	h,MsgNEr	; can't erase it
	call	pstr
	jmp	Exit
OpnOu1:	lxi	d,OutFcb
	call	f$mopen
	rz			; (okay)
	lxi	h,MsgNOF	; open error
	call	pstr
	jmp	Exit
;
; 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:	lxi	h,MsgREr	; we have an input read error
	call	pstr
	jmp	Abort
;
WrtErr:	lxi	h,MsgWEr	; we have an output write error
	call	pstr
	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)
	lxi	h,MsgCIF
	call	pstr		; error
	jmp	Abort
;
; ClsOFl -- closes output file
;
ClsOFl:	call	OutDU
	lda	OpOFlg		; check option O flag
	ora	a
	jrnz	SkpEof		; (object file transfer, skip EOF)
	mvi	a,CpmEof	; put end-of-file character
	call	FPutC
	lda	PutPtr		; check pointer
	ora	a
	jz	ClsOut		; we just wrote, so close
	mov	b,a
	mvi	a,128		; fill rest of record with ^Z
	sub	b
	mov	b,a
FillZ:	mvi	a,CpmEof
	push	b
	call	FPutC
	pop	b
	djnz	FillZ
	jr	WrLast
;
SkpEof:	lda	PutPtr		; check pointer
	ora	a
	jz	ClsOut		; just wrote, so close
WrLast:	lxi	d,OWork		; we've got to write the last record
	mvi	c,SetDma
	call	Bdos
	lxi	d,OutFcb
	mvi	c,FWrite
	call	Bdos
	ora	a		; check for error
	jnz	WrtErr		; (yes, abort)
;
ClsOut:	call	OutDU		; close output file
	lxi	d,OutFcb
	call	f$close
	rz			; (okay)
	lxi	h,MsgCOF
	call	pstr		; close error
	jmp	Abort1
;
; GetDfD -- gets default disk (A=0) and stores it (A=1)
;
GetDfD:	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)
	lxi	d,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:	lxi	h,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	PutPtr		; get pointer
	cpi	128		; buffer full?
	jrc	PutChr		; (no, so do it)
	push	b		; the character is threatened from all sides
	lxi	d,OWork
	mvi	c,SetDma	; setting output DMA
	call	Bdos
	call	OutDU		; set drive and user
	lxi	d,OutFcb	; ..and write out buffer
	mvi	c,FWrite
	call	Bdos
	pop	b		; get back out character
	cpi	0		; return code?
	jrnz	PutErr		; (problem)
	sta	PutPtr		; reset pointer to 0
;
PutChr:	lxi	h,OWork		; point to DMA buffer
	mov	e,a		; move pointer to DE
	mvi	d,0
	dad	d		; ..and add it to HL
	mov	m,c		; write character
	lxi	h,PutPtr
	inr	m		; increment pointer
	sub	a		; clear carry
	ret
;
PutErr:	stc			; set carry
	ret
;
; 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
	ret
;
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
	ret
;
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	'O'		; O = object file transfer
	dw	OptO
	db	0		; end of option jump table
;
; Option setting routines
;
OptH:	lxi	h,MsgUse
	call	pstr
	jmp	Exit
OptO:	sta	OpOFlg
	ret
;
; Data storage . . .
;
OpOFlg:	db	0
;
OutFil:	db	'        '	; save original output filename here
OutTyp:	db	'   '
BakTyp:	db	'BAK'		; for BAK file
TmpTyp:	db	'$$$'		; for temporary filename
;
GetFlg:	db	0		; FGetC end-of-file flag
GetPtr:	db	0		; FGetC pointer
InpFcb:	db	0		; input file fcb
FcbIFn:	db	'        '
FcbIFt:	db	'   '
	ds	24
;
PutPtr:	db	0		; FPutC pointer
OutFcb:	db	0		; output file fcb
FcbOFn:	db	'        '
FcbOFt:	db	'   '
	ds	24
;
	DSEG
;
; Uninitialized storage . . .
;
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
OldStk:	ds	2		; old stack pointer
TailPt:	ds	2		; command tail index pointer
CTail:	ds	128		; command tail storage
;
IWork:	ds	128*BufSiz	; input buffer
OWork:	ds	128*BufSiz	; output buffer
;
	end