; PRETTY.Z80
;
;	Source code case formatter for ZCPR3.
;
Vers	equ	30
SubVers	equ	' '
;
; USAGE:
;
;	PRETTY {dir:}infile {dir:}{outfile} {{/}options}
;
; OPTIONS:
;
;	I	Intel mnemonics.
;
;	Z	Zilog mnemonics.
;
;	Q	Toggle quiet mode.
;
; For more information see the accompanying DOC file.
;
; For version history see the accompanying HIS file.
;
; System addresses . . .
;
CpmFcb	equ	5Ch		; default file control block
AltFcb	equ	6Ch		; alternate file control block
CpmDma	equ	80h		; default DMA buffer
;
MaxRec	equ	80h		; buffer 16k of records
;
; ASCII characters . . .
;
CtrlC	equ	3
BEL	equ	7
TAB	equ	9
LF	equ	10
CR	equ	13
CpmEof	equ	1Ah
;
	.request	zslib,z3lib,syslib
;
	ext	getstp,setstp
	ext	zsyschk,z3init,getquiet,puter2,inverror,prtname
	ext	setdma,cout,condin,eprint,pfn2,pafdc,retud,logud,$memry
	ext	initfcb,f$make,f$open,f$read,f$write,f$close,f$delete,f$rename
;
	public	print		; for zsyschk
;
	jp	Start
;
	db	'Z3ENV'
	db	1
Z3EAdr:	dw	0FE00h
;
; Configuration bytes
;
	dw	0		; filler
	db	'PRETTY'	; for ZCNFG
	db	Vers/10+'0',Vers mod 10+'0'
QtFlag:	db	0		; FFh=default to quiet mode
ModFlg:	db	0		; FFh=default to Intel, 0=Zilog
MCFlag:	db	0		; FFh=mnemonics upper-case, 0=lower-case
LCFlag:	db	1		; 1=labels upper, 2=lower, 4=no change
;
Start:	ld	hl,(Z3EAdr)
	call	zsyschk		; Z-system?
	ret	nz		; (no, abort before it's too late)
	call	z3init
	ld	(Stack),sp
	ld	sp,Stack
	ld	hl,($memry)	; set buffer address
	ld	(Buffer),hl
	xor	a		; initialize data
	ld	hl,TabTyp
	ld	b,6
Start1:	ld	(hl),a
	inc	hl
	djnz	Start1	
	call	retud		; get default drive
	ld	(DftUsr),bc
	call	getquiet	; check quiet mode
	rra
	sbc	a
	jr	nz,Start2
	ld	a,(QtFlag)
Start2:	ld	(OpQFlg),a
	ld	a,(CpmFcb+1)
	cp	' '
	jp	z,Usage
;
	call	Main		; call main program
;
Finish:	xor	a		; zero error flag
ErExit:	ld	b,a
	call	puter2
	or	a
	call	nz,inverror
Exit:	ld	sp,(Stack)	; here we drop our toys and run
	ret
;
Abort:	cp	CtrlC
	ret	nz
	call	eprint
	db	'  Aborted.',0
	call	EraOut
	ld	a,4
	jr	ErExit
;
DirErr:	call	eprint
	db	'  Invalid directory.',0
	ld	a,2
	jr	ErExit
;
DSpErr:	call	eprint
	db	'  No directory space.',0
	ld	a,11
	jr	ErExit
;
FnfErr:	call	eprint
	db	'  File not found.',0
	ld	a,10
	jr	ErExit
;
WrtErr:	call	EraOut
	call	eprint
	db	'  Disk full.',0
	ld	a,11
	jp	ErExit
;
;Is this a real invocation or is this a Sears invocation?
;
Usage:	call	eprint
	db	'PRETTY    Version '
	db	Vers/10+'0','.',Vers mod 10+'0',SubVers,CR,LF
	db	'Z-System Source Code Case Formatter',CR,LF
	db	'Usage:',CR,LF,'   ',0
	call	prtname
	call	eprint
	db	' {dir:}infile {dir:}{outfile} {{/}options}',CR,LF
	db	'Options:',CR,LF
	db	'   I   Intel mnemonics.',CR,LF
	db	'   Z   Zilog mnemonics.',CR,LF
	db	'   Q   Toggle quiet mode o',0
	ld	a,(OpQFlg)
	or	a
	call	z,PrtOn
	call	nz,PrtOff
	call	eprint
	db	'.',CR,LF
	db	'If no I or Z option, looks for LD, MOV, MVI, or LXI opcode in ',CR,LF
	db	'first 16K of file.  If no match is found, defaults to ',0
	ld	a,(ModFlg)
	or	a
	call	z,PrtZil
	call	nz,PrtInt
	jp	Finish
;
PrtOn:	call	eprint
	db	'n',0
	ret
PrtOff:	call	eprint
	db	'ff',0
	ret
PrtZil:	call	eprint
	db	'Zilog.',0
	ret
PrtInt:	call	eprint
	db	'Intel.',0
	ret
PrtTo:	call	eprint
	db	' to',0
	ret
;
; EraOut -- erases output file on error
;
EraOut:	ld	bc,(OutUsr)
	call	logud
	ld	de,OutFcb
	call	initfcb
	call	f$close
	call	f$delete
	ret
;
; Get directory specs, then open files
;
Main:	call	GetOpt
	ld	hl,CpmFcb+1	; check for ambiguous filenames
	call	ChkAmb
	ld	hl,AltFcb+1
	call	ChkAmb
	ld	a,(CpmFcb+15)	; check for invalid directories
	or	a
	jp	nz,DirErr	; (invalid DU)
	ld	a,(AltFcb+15)
	or	a
	jp	nz,DirErr
	ld	a,(CpmFcb+13)	; get input user and drive
	ld	c,a
	ld	a,(CpmFcb)	; A=1
	or	a
	jr	nz,Main2
	ld	a,(DftDsk)	; no drive, use default
	inc	a
Main2:	dec	a
	ld	b,a
	ld	(InUsr),bc	; store infile drive and user
	ld	hl,CpmFcb+1	; ..and move filename
	ld	de,InFcb+1
	ld	bc,11
	ldir
	ld	a,(AltFcb+13)	; get outfile user and drive
	ld	c,a
	ld	a,(AltFcb)
	or	a
	ld	b,a
	jr	nz,Main3
	ld	a,(DftDsk)
	ld	b,a
	inc	b
	ld	a,(AltFcb+1)
	cp	'/'
	jr	z,Main4
;
Main3:	dec	b
	ld	(OutUsr),bc	; store outfile DU
	ld	hl,AltFcb+1	; check for filename
	ld	a,(hl)
	cp	' '
	jr	nz,Main4a
Main4:	ld	hl,CpmFcb+1	; none, use infile name
Main4a:	ld	de,OutFcb+1
	ld	bc,11
	ldir
	ld	hl,OutFcb+1	; move outfile name to storage
	ld	de,OutNam+1
	ld	bc,11
	ldir
	ld	hl,TmpTyp	; move temporary type ($$$) to OutFcb
	ld	de,OutFcb+9
	ld	bc,3
	ldir
	ld	bc,(InUsr)	; log into infile directory
	call	logud
	ld	de,InFcb
	ld	a,(OpQFlg)
	or	a
	call	z,PrtFn
	call	initfcb
	call	f$open		; open file
	jp	nz,FnfErr	; (no file found)
	ld	a,(OpQFlg)
	or	a
	call	z,PrtTo
	ld	bc,(OutUsr)	; log into outfile directory
	call	logud
	ld	de,OutNam
	ld	a,(OpQFlg)
	or	a
	call	z,PrtFn
	ld	de,OutFcb
	call	initfcb
	call	f$make		; create output file
	inc	a
	jp	z,DSpErr	; (no directory space)
	ld	bc,(InUsr)	; set infile DU
	call	logud	
	ld	de,(Buffer)	; store buffer address in pointer
	ld	(BufPtr),de
	ld	b,MaxRec	; maximum record count
InLoop:	ld	hl,80h		; add offset to buffer address
	add	hl,de
	ld	(DmaAdr),hl
	ex	de,hl
	call	setdma		; set DMA address
	ex	de,hl
	ld	de,InFcb
	call	f$read		; read a sector
	or	a
	jp	nz,RdErr
	ld	de,(DmaAdr)
	djnz	InLoop
; We've read in a buffer's-worth (16k).  Come out of that with DmaAdr =
; Buffer + limit ... first free address after what was read in.  Backing
; from there, look for carriage return.
	ex	de,hl		; put current DmaAdr in HL
	dec	hl		; from next to last buffer address
	ld	bc,0		; we'll get a count from this
	ld	a,CR
	cpdr
	inc	hl		; CPDR steps to below carriage return
	ld	(BufLim),hl	; last byte address for process loop
	ld	de,(Buffer)	; try it on first
	or	a
	sbc	hl,de
	jr	c,NoCR		; not a single carriage return in buffer
	ld	(NegOfs),bc
	add	hl,hl		; shift left -- now H = whole record count
	ld	a,h
	ld	(RecCnt),a	; stash it for later output stuff
; Process file, stopping at limit-address.
	call	Proces
; Now write that out and get the next batch.
OutWrt:	ld	bc,(OutUsr)	; log outfile DU
	call	logud
	ld	a,(RecCnt)
	ld	b,a
	ld	de,(Buffer)
OutLp:	call	condin
	call	nz,Abort
	ld	hl,80h
	add	hl,de
	ld	(DmaAdr),hl	; store next cycle's DMA address
	ex	de,hl
	call	setdma		; set DMA address
	ex	de,hl
	ld	de,OutFcb
	call	f$write		; write a sector
	or	a
	jp	nz,WrtErr
	ld	de,(DmaAdr)
	djnz	OutLp
; Are we done?
	ld	a,(EndFlg)	; set by RdErr
	or	a
	jp	nz,AlDone
; DE = first byte of unshipped records
	ld	hl,(Buffer)
	push	hl		; save buffer address
	ld	bc,MaxRec*128
	add	hl,bc
	or	a
	sbc	hl,de		; HL = byte count to move down
	push	hl
	pop	bc		; throw it into BC
	pop	hl		; get back buffer address
	ex	de,hl
; now DE = start of buffer, HL = start of unshipped stuff, BC = copydown
; byte count.  Copy down the uncompleted chunk in whole records (with a
; process-resume address within the first record.
	ldir
; DE = starting DmaAdr for next input burst (must be preserved).
	push	de
	pop	hl		; copy DE into HL
	ld	bc,(NegOfs)
	add	hl,bc		; HL = new address of last processed CR
	inc	hl		; step to the LF
	ld	a,(hl)
	cp	LF
	jr	nz,NotLF	; don't start processing at a LF
	inc	hl
NotLF:	ld	(BufPtr),hl	; set the pointer
	ld	bc,(InUsr)
	call	logud
	ld	a,(RecCnt)
	ld	b,a
	jp	InLoop
;
; Something's wrong.  There's not a carriage return in the whole buffer.
; Is it from a C program?  Run FULLEOL on it to add CR's.
NoCR:	call	EraOut
	call	eprint
	db	'  Not a text file.',0
	ld	a,4
	jp	ErExit
;
; We've hit end-of-file, signalled by a read error.  If it's not an
; empty file, it's the last hit.
RdErr:	ld	a,0FFh
	ld	(EndFlg),a
	ld	a,MaxRec
	cp	b
	jr	nz,LasRec
	call	EraOut
	call	eprint
	db	'  Empty file.',0
	ld	a,4
	jp	ErExit
; DmaAdr = Buffer + (real records) + 80h.
LasRec:	ld	de,-80h
	ld	hl,(DmaAdr)
	add	hl,de
	dec	hl
	ld	(BufLim),hl	; BufLim = last buffer address
	inc	hl
	ld	de,(Buffer)
	or	a
	sbc	hl,de
	add	hl,hl		; shift left
	ld	a,h
	ld	(RecCnt),a
	call	Proces
	jp	OutWrt
;
; Close files and head home.
AlDone:	ld	bc,(InUsr)
	call	logud
	ld	de,InFcb
	call	f$close		; close infile
	ld	bc,(OutUsr)
	call	logud
	ld	de,OutFcb
	call	f$close		; close outfile
	call	DatStp		; transfer date stamp
; We've got some renaming to do before we can close shop.
; Blind-delete:  outfile.BAK
; Blind-rename:  outfile.typ to outfile.BAK
; Rename:  outfile.$$$ to outfile.typ
	ld	hl,OutFcb+1	; move outfile name to InFcb
	ld	de,InFcb+1
	ld	bc,8
	ldir
	ld	hl,BakTyp	; move BAK to InFcb filetype
	ld	bc,3		; DE already points to InFcb+9
	ldir
	ld	de,InFcb	; blind erase any existing BAK file
	call	initfcb
	call	f$delete
	ex	de,hl		; blind rename to BAK
	ld	de,OutNam	; ..any existing file
	call	f$rename
	ex	de,hl		; rename to final name
	ld	de,OutFcb
	call	f$rename
	ret
;
; Proces -- The "inner-machine".  Here it's a case-enforcer, but it
; could be anything.  Until limit, run forward through the buffer.
; First time through, test the input text.  If it has a MOV, MVI, or
; LXI instruction, it's in Intel idiom.  If it has an LD instruction,
; it's in Zilog idiom.  If it has neither, use configured default.
; Entry:  HL = address of first character of line.
;
Proces:	ld	a,(OpcChk)	; have we checked the opcodes?
	or	a
	jr	nz,Not1st	; (yes, or option was given)
	ld	a,(TabTyp)
	cp	'Z'
	jr	z,IsZilg
	cp	'I'
	jr	z,IsIntl
; No option was given, so we're going to decide for ourselves
	ld	hl,(Buffer)
MvToSp:	call	FindAN
	jr	nc,NotCRy
	cp	CpmEof
	jr	z,ChkDft
NotCRy:	call	ChkLim
	jr	c,ChkDft
	jr	z,ChkDft
	ld	de,TableX
	call	TMatch		; returns with HL unchanged
	jr	z,GotMat	; (found a match)
	call	FndWSp		; move it across, so FindAN will
	jr	MvToSp		; ..have to move forward
;
GotMat:	call	FndWSp
	jr	c,MvToSp
	inc	de
	ld	a,(de)
	cp	1Ah
	jr	z,IsZilg
	cp	0Ch
	jr	z,IsIntl
ChkDft:	ld	a,(ModFlg)	; we can't decide, so use default
	or	a
	jr	z,IsZilg
IsIntl:	ld	hl,Tab1I
	ld	(Table1),hl
	ld	hl,Tab2I
	ld	(Table2),hl
	ld	hl,Tab3I
	ld	(Table3),hl
	ld	hl,Tab4I
	ld	(Table4),hl
	jr	End1st
;
IsZilg:	ld	hl,Tab1Z
	ld	(Table1),hl
	ld	hl,Tab2Z
	ld	(Table2),hl
	ld	hl,Tab3Z
	ld	(Table3),hl
	ld	hl,Tab4Z
	ld	(Table4),hl
End1st:	ld	hl,Tab5Z	; table 5 is always the same
	ld	(Table5),hl
	ld	a,0FFh
	ld	(OpcChk),a	; note that we've checked the opcodes
; Enter here if it's not the first time through
Not1st:	ld	hl,(BufPtr)
PrimLp:	push	hl
PrimL2:	call	IsWSp
	jr	nz,CmmtCk
	inc	hl
	jr	PrimL2
CmmtCk:	cp	'*'
	jr	z,CmmtLn
	cp	';'
	jr	nz,NoCmmt
CmmtLn:	pop	bc		; flush it
SpAnLp:	call	FndWSp
	call	FindAN
	jr	nc,SpAnLp
	jr	DoneLn
NoCmmt:	pop	hl
	call	LineLp
DoneLn:	ld	a,(EofFlg)
	or	a
	ret	nz
	push	hl
	call	ChkLim
	pop	hl
	jr	nc,PrimLp
	ret
;
; Found 'END'.  Everything from here to CpmEof is to be treated as
; comments.
;
GotEnd:	call	CasOpc		; case the 'END'
	pop	bc		; flush one call layer, bypassing
	ld	a,CpmEof	; ..PrimLp, and exit
	ld	(EofFlg),a
	ret
;
GotEof:	ld	a,CpmEof
	ld	(EofFlg),a
	ret
;
LineLp:	ld	a,(hl)		; is it end of file (^Z)?
	and	7Fh		; mask bit, just in case
	cp	CpmEof
	jr	z,GotEof
	call	IsWSp		; is it a label?
	jr	z,NoLbl
	call	UpLbl		; case any first-column label
NoLbl:	call	FindAN		; step to next alphanumeric
	ret	c		; carry set if carriage return
	ld	de,(Table5)	; 'END'
	call	TMatch
	jr	z,GotEnd
	ld	de,(Table2)	; DB, DS, etc.
	call	TMatch
	jr	z,DoLow
	ld	de,(Table1)
	call	TMatch		; string-match -- opcode?
	jr	nz,NotOpc
	call	CasOpc		; case the opcode
	inc	de
	ld	a,(de)		; LD C,(DE)?  No?  Then it isn't
	ld	c,a		; ..really logical
	call	FindAN
	ret	c
	dec	c
	jr	z,NoArg 	; 1. No argument expected
	dec	c
	jr	z,NotOpc 	; 2. Symbol or number only
	dec	c
	jr	z,RegArg	; 3. Register arguments
	ld	de,(Table4)
	call	TMatch		; 4. Branch conditions
	jr	nz,NotOpc
	call	CasOpc		; case any argument, then
	jr	NotOpc		; ..format the address/symbol
;
RegArg:	ld	de,(Table3)
	call	FindAN		; walk around '(', comma, etc.
	ret	c		; (if carriage return)
	call	TMatch		; is it a register argument?  Z=yes.
	call	z,CasOpc	; returns with zero set
	call	nz,UpLbl
	call	ToCmma
	jr	z,RegArg	; zero set if comma
NoArg:	call	FindAN
	ret	c
NotOpc:	call	UpLbl		; case until whitespace
	jr	NoArg
;
DoLow:	call	CasOpc		; case for B characters
	jr	NoArg
;
; ToCmma -- pass to comma.  HL = address of characters.  Steps HL to
; either comma or white space.  Returns zero set on comma.  Returns
; carry set if CpmEof (^Z), semi-colon, single-quote, or carriage return.
;
ToCmma:	ld	a,(hl)
	cp	','
	ret	z
	call	IsWSp
	jr	z,IsCmma
	inc	hl
	jr	ToCmma
;
IsCmma:	or	a
	jr	z,IsCmm2
	cp	CR
	jr	z,IsCmm1
	cp	CpmEof
	jr	z,IsCmm1
	cp	''''
	jr	z,IsCmm1
	cp	';'
	jr	z,IsCmm1
	or	a		; reset zero flag
	ret
;
IsCmm1:	or	a
	scf			; set carry
	ret
;
IsCmm2:	dec	a		; reset zero flag
	ret
;
; ChkLim -- limit check.  Compares HL with BufLim.  On return, carry
; set if HL > (BufLim).
;
ChkLim:	ex	de,hl
	push	hl
	or	a
	ld	hl,(BufLim)
	sbc	hl,de
	pop	hl
	ex	de,hl
	ret
;
; CasOpc -- cases opcodes according to MCFlag
; Entry:  HL = address of first character, B = byte count
; Exit:  HL = address of next character
;
CasOpc:	ld	a,(MCFlag)
	or	a
	jr	nz,UpCasB
;
; LoCasB -- lower-caser
; Entry:  HL = address of first character, B = byte count
; Exit:  HL = address of next character
LoCasB:	ld	a,(hl)
	and	5Fh
	cp	'Z'+1
	jr	nc,SkpLo
	cp	'A'
	jr	c,SkpLo
	ld	a,(hl)
	or	20h		; lower-case it
	ld	(hl),a
SkpLo:	inc	hl
	djnz	LoCasB
	cp	a		; set zero flag
	ret
; UpCasB -- upper-caser (like LoCasB above)
UpCasB:	ld	a,(hl)
	or	20h
	cp	'z'+1
	jr	nc,SkpUp
	cp	'a'
	jr	c,SkpUp
	ld	a,(hl)
	and	5Fh		; upper-case it
	ld	(hl),a
SkpUp:	inc	hl
	djnz	UpCasB
	cp	a		; set zero flag
	ret
;
; UpLbl -- label upper-caser.  HL == address of first character of
; label or number.  Upper-cases until white space or colon if not
; standard-rules number.
;
UpLbl:	call	IsDigt		; first character a digit?
	jr	c,Number	; (it's a number)
UpLbLp:	call	CasChr		; A = (HL) & 5Fh
	jr	nc,UpNxt
	ld	(hl),a
UpNxt:	call	ColWSp
	ret	z
	inc	hl
	jr	UpLbLp
;
; FndWSp -- find white space forward.  HL = address of first
; non-whitespace character of word.  Returns HL = address of
; whitespace above that word, and B = byte count, including
; that white space byte.
;
FndWSp:	ld	b,1
FWSpLp:	call	IsWSp
	ret	c
	ret	z
	inc	b
	inc	hl
	jr	FWSpLp
;
; IsWSp -- white space test.  HL points to character to test.  Returns
; with zero set if carriage return, line feed, tab, space, or null.
; Returns carry set if CpmEof (^Z), semi-colon, or single-quote.
;
IsWSp:	ld	a,(hl)
	and	7Fh
	cp	' '
	ret	z
	cp	TAB
	ret	z
	cp	CR
	ret	z
	cp	LF
	ret	z
	cp	CpmEof
	jr	z,IsWSp2
	cp	';'
	jr	z,IsWSp2
	cp	''''
	jr	z,IsWSp2
	or	a		; reset zero (unless null)
	ret
IsWSp2:	or	a		; reset zero flag
	scf			; ..and set carry
	ret
;
; Number -- Number caser.  HL = address of first digit of an expected
; hexadecimal number.  Upper-cases A-F within it, lower-cases any
; trailing letter.  Rolls right over any illegal character. Returns
; HL = address of first white space above, zero set, except returns
; carry set if that boundary is CpmEof (^Z), semi-colon, or single-quote.
;
Number:	inc	hl
	call	ComWSp
	ret	z
	call	IsDigt
	jr	c,Number
	call	MatDon		; is this a trailing letter?
	jr	z,Numb1
	call	IsAF
	jr	nc,Number
	ld	a,(hl)
	and	5Fh
	ld	(hl),a
	jr	Number
;
Numb1:	call	UpChar
	jr	nc,Numb2
	ld	a,(hl)
	or	20h
	ld	(hl),a
Numb2:	inc	hl
	ret
;
; FindAN -- find next alphanumeric character.  Moves HL to point to
; A-Z, a-z, or 0-9.  Steps across single-quote-bounded strings and
; semi-colon to carriage return comments.  Returns HL = address of
; alphanumeric character and zero set, or carry set if carriage
; return or exclamation point.
;
FindAN:	call	UpChar
	jr	c,FndNxt
	call	IsDigt
	jr	c,FndNxt
	cp	';'		; wink?
	jr	z,Commnt
	cp	''''		; tick?
	jr	z,FndQte
	cp	CR
	jr	z,FndCR
	cp	'!'		; ball/bat?
	jr	z,FndExc
	inc	hl
	jr	FindAN
;
Commnt:	inc	hl
	ld	a,(hl)
	cp	CR
	jr	nz,Commnt
FndCR:	inc	hl
	ld	a,(hl)
	cp	LF
	jr	nz,FndDon
	inc	hl
	jr	FndDon
;
FndQte:	inc	hl
	ld	a,(hl)
	cp	CR
	jr	z,FndDon	; partial fix
	cp	''''
	jr	nz,FndQte
	inc	hl
	ld	a,(hl)
	cp	''''
	jr	nz,FindAN
	jr	FndQte
;
FndNxt:	cp	a		; set zero, reset carry
	ret
;
FndExc:	inc	hl		; step across bang
FndDon:	scf			; set carry -- caller should give
	ret			; ..that higher priority than zero
;
; CasChr -- tests (HL).  Returns carry flag set if byte is A-Z or a-z.
;
CasChr:	ld	a,(LCFlag)	; upper or lower?
	bit	0,a
	jr	nz,UpChar	; (to upper-case)
	bit	1,a
	jr	nz,LwChar	; (to lower-case)
	ld	a,(hl)
	jr	Skip
;
LwChar:	ld	a,(hl)
	and	5Fh
	cp	'Z'+1
	jr	nc,Skip
	cp	'A'
	jr	c,Skip
	ld	a,(hl)
	or	20h
Skip:	cp	'a'
	ccf
	ret
;
UpChar:	ld	a,(hl)
	and	5Fh
	cp	'Z'+1
	ret	nc
	cp	'A'
	ccf
	ret
;
; IsDigt -- tests (HL).  Returns carry flag set if byte is 0-9.
;
IsDigt:	ld	a,(hl)
	cp	'9'+1
	ret	nc
	cp	'0'
	ccf
	ret
;
; IsAF -- tests (HL).  Returns carry flag set if byte is A-F or a-f.
;
IsAF:	ld	a,(hl)
	and	5Fh
	cp	'F'+1
	ret	nc
	cp	'A'
	ccf
	ret
;
; TMatch -- table searcher to null byte.  HL = address of string to
; match, DE = address of first byte of match-table of string entries.
; Table entries are in ascending ASCII order, with at most one non-null
; control byte trailing each string.  Table is terminated with a null.
; Each string entry has high bit set on the last character.  On find,
; returns with zero set, byte count in B, and DE = address of last byte
; of entry.  Concept is from SYMSCH in REZ (Dave Barker).
;
TMatch:	push	hl		; save the starting address
	call	Match
	jr	z,TMDone
	jr	c,TMDone
	jr	TMat2
TMat1:	inc	de		; match fell off, so we gotta
TMat2:	ld	a,(de)		; ..cripple over to next entry
	cp	80h
	jr	c,TMat1
TMat3:	inc	de		; found the top-bit, next is null?
	ld	a,(de)		; then that's it for the table
	or	a
	jr	nz,TMat4
	dec	a		; roll it to 0FFh, set carry, reset zero
TMDone:	pop	hl		; get starting address back
	ret
;
TMat4:	cp	' '		; next is control?  skip. (Table 1)
	jr	c,TMat3
	pop	hl
	jr	TMatch
;
; Match -- string comparator to high bit.  HL = address of string to
; match, DE = address of table entry.  On match, returns with zero set,
; DE = address of last byte of entry.  Increments B as a byte count for
; case-manipulation.  On non-match, carry is set if test string is higher
; in value than table entry.  Match must be complete:  HL$ to white space,
; DE$ to high bit.
;
Match:	ld	b,1		; initialize bytecounter
MatLp:	ld	a,(de)
	and	7Fh
	ld	c,a
	call	UpChar		; A = *HL & 5Fh.  We need that mask.
	ld	a,(hl)
	and	5Fh
	cp	'Z'+1
	jr	nc,Match2
	cp	'A'
	jr	nc,Match3	; only if it's alpha, though
Match2:	ld	a,(hl)		; otherwise, get an unblemished copy
Match3:	cp	c		; carry set if *HL < *DE
	jr	nz,Match4
	ld	a,(de)
	cp	80h		; last character of table entry has
	jr	nc,MatDon	; ..high bit set
	inc	hl
	inc	de
	inc	b
	jr	MatLp
;
Match4:	ret	nc
	call	ComWSp		; HL$ shorter than table entry?
	scf			; then there are more possible
	ret	nz		; table entries -- carry would
	or	a		; preclude their test
	ret
;
MatDon:	push	hl		; HL$ longer than table entry?
	inc	hl		; then we didn't match the whole thing
	call	ComWSp
	pop	hl
	ret	z
	or	a		; reset carry and zero
	ret
;
; ComWSp -- test *HL for white space, comma, paren, or bang.
;
ComWSp:	call	IsWSp
	ret	z
	cp	','
	ret	z
	cp	')'
	ret	z
	cp	'!'
	ret
;
; ColWSp -- test *HL for white space, colon, comma, paren, or bang.
;
ColWSp:	call	IsWSp
	ret	z
	cp	','
	ret	z
	cp	')'
	ret	z
	cp	'!'
	ret	z
	cp	':'
	ret
;
; PrtFn -- print DU and filename pointed to by DE.
;
PrtFn:	push	de
	inc	de
	ld	a,' '
	call	cout
	call	retud
	ld	a,b
	add	'A'
	call	cout
	ld	a,c
	call	pafdc
	ld	a,':'
	call	cout
	call	pfn2
	pop	de
	ret
;
; ChkAmb -- check for ambiguous filename at address in HL.
;
ChkAmb:	ld	bc,11
	ld	a,'?'
	cpir
	ret	nz		; (okay)
	call	eprint		; ambiguous filenames not allowed
	db	'  Ambiguous filename.',0
	ld	a,8		; set error code
	jp	ErExit
;
; GetOpt -- checks command tail for user supplied options and sets
; appropriate option flags.
;
GetOpt:	ld	hl,CpmDma	; point to command tail
	ld	a,(hl)		; anything there
	or	a
	ret	z		; (no)
	inc	hl
	call	EatSpc
	cp	'/'
	jr	z,IsSlsh
FnLp1:	inc	hl		; move past first filename
	ld	a,(hl)
	or	a
	ret	z		; (end of tail)
	cp	' '
	jr	z,GetOp1
	cp	TAB
	jr	nz,FnLp1
GetOp1:	call	EatSpc
	or	a
	ret	z		; (end of tail)
	cp	'/'		; is it a slash?
	jr	z,IsSlsh	; (yes)
FnLp2:	inc	hl		; move past second filename
	ld	a,(hl)
	or	a
	ret	z		; (end of tail)
	cp	' '
	jr	z,GetOp2
	cp	TAB
	jr	nz,FnLp2
GetOp2:	call	EatSpc
	or	a
	ret	z		; (end of tail)
	cp	'/'		; a slash?
	jr	nz,GotOpt	; (no, get options)
IsSlsh:	inc	hl		; move past slash
GotOpt:	ld	a,(hl)		; get option
	inc	hl
	or	a
	ret	z		; (end of tail)
	cp	' '		; space?
	jr	z,GotOpt	; (skip it)
	cp	'/'		; usage request?
	jp	z,Usage		; (yes)
	cp	'I'		; Intel file?
	jr	z,OptT		; (yes)
	cp	'Z'		; Zilog file?
	jr	z,OptT		; (yes)
	cp	'Q'		; quiet mode toggle?
	jr	z,OptQ
	call	eprint
	db	'  Invalid option.',0
	ld	a,19		; set error code
	jp	ErExit
;
OptT:	ld	(TabTyp),a
	jr	GotOpt
;
OptQ:	ld	a,(OpQFlg)
	cpl
	ld	(OpQFlg),a
	jr	GotOpt
;
; EatSpc -- gobbles up spaces and tabs.
;
EatSpc:	ld	a,(hl)
	or	a
	ret	z
	inc	hl
	cp	' '		; is it a space?
	jr	z,EatSpc	; (yes)
	cp	TAB		; is it a tab?
	jr	z,EatSpc	; (yes)
	dec	hl
	ret
;
; DatStp -- Get create stamp from original file, if available, and
; transfer it to new file.
;
DatStp:	ld	bc,(InUsr)
	call	logud
	ld	de,InFcb
	ld	hl,CpmDma	; point to DMA buffer
	call	GetStp		; get ZSDOS file stamp
	ret	nz		; (error)
	ld	a,(CpmDma+1)	; check for create date
	or	a
	jr	nz,DatSt1	; (we've got a create date)
	ld	a,(CpmDma+11)	; none, so check for modify date
	or	a
	ret	z		; (no date stamp)
	ld	hl,CpmDma+10	; point to modify date
	jr	DatSt2
DatSt1:	ld	hl,CpmDma	; point to create date
DatSt2:	ld	de,StpTmp	; move date to storage
	ld	bc,5
	ldir
	ld	bc,(OutUsr)
	call	logud
	ld	de,OutFcb
	ld	hl,CpmDma	; point to DMA buffer
	call	GetStp		; get file stamp
	ret	nz		; (error)
	ld	hl,StpTmp
	ld	de,CpmDma	; move old create stamp to date string
	ld	bc,5
	ldir
	ld	de,OutFcb	; setup for file stamping
	ld	hl,CpmDma
	call	SetStp		; set file stamp
	ret
;
; So ZSYSCHK will not load PRINT, PSTR, etc.
;
print:	jp	eprint
;
; Mnemonics tables . . .
;
; Zilog Mnemonics -- lower-cased because they are translated directly into
; program bytes on a one-to-one basis.
;
; Numeric arguments:
;
;	0	End Of table
;	1	No arguments expected
;	2	Value/symbol argument
;	3	Use TablZ3 for casing arguments
;	4	Use TablZ4 for casing arguments
;
Tab1Z:	dc	'ADC'
	db	3
	dc	'ADD'
	db	3
	dc	'AND'
	db	3
	dc	'BIT'
	db	3
	dc	'CALL'
	db	4
	dc	'CCF'
	db	1
	dc	'CP'
	db	3
	dc	'CPD'
	db	1
	dc	'CPDR'
	db	1
	dc	'CPI'
	db	1
	dc	'CPIR'
	db	1
	dc	'CPL'
	db	1
	dc	'DAA'
	db	1
	dc	'DEC'
	db	3
	dc	'DI'
	db	1
	dc	'DJNZ'
	db	2
	dc	'EI'
	db	1
	dc	'EX'
	db	3
	dc	'EXX'
	db	1
	dc	'HALT'
	db	1
	dc	'IM'
	db	2
	dc	'IM0'
	db	1
	dc	'IM1'
	db	1
	dc	'IM2'
	db	1
	dc	'IN'
	db	3
	dc	'INC'
	db	3
	dc	'IND'
	db	1
	dc	'INDR'
	db	1
	dc	'INI'
	db	1
	dc	'INIR'
	db	1
	dc	'JP'
	db	4
	dc	'JR'
	db	4
	dc	'LD'
	db	3
	dc	'LDD'
	db	1
	dc	'LDDR'
	db	1
	dc	'LDI'
	db	1
	dc	'LDIR'
	db	1
	dc	'NEG'
	db	1
	dc	'NOP'
	db	1
	dc	'OR'
	db	3
	dc	'OTDR'
	db	1
	dc	'OTIR'
	db	1
	dc	'OUT'
	db	3
	dc	'OUTD'
	db	1
	dc	'OUTI'
	db	1
	dc	'POP'
	db	3
	dc	'PUSH'
	db	3
	dc	'RES'
	db	3
	dc	'RET'
	db	4
	dc	'RETI'
	db	1
	dc	'RETN'
	db	1
	dc	'RL'
	db	3
	dc	'RLA'
	db	3
	dc	'RLC'
	db	3
	dc	'RLCA'
	db	3
	dc	'RLD'
	db	3
	dc	'RR'
	db	3
	dc	'RRA'
	db	3
	dc	'RRC'
	db	3
	dc	'RRCA'
	db	3
	dc	'RRD'
	db	3
	dc	'RST'
	db	2
	dc	'SBC'
	db	3
	dc	'SCF'
	db	1
	dc	'SET'
	db	3
	dc	'SLA'
	db	3
	dc	'SRA'
	db	3
	dc	'SRL'
	db	3
	dc	'SUB'
	db	3
	dc	'XOR'
	db	3
	dw	0
;
; Pseudo-ops -- lower-cased because they are at the heart of the program's
; nature and cause simple one-for-one translation of listed ASCII into
; program and data bytes.  Other pseudo-ops control assembler machinery of
; some complexity; they are upper-cased to stand out.
;
Tab2Z:	dc	'ASET'
	dc	'DB'
	dc	'DC'
	dc	'DEFB'
	dc	'DEFC'
	dc	'DEFL'
	dc	'DEFM'
	dc	'DEFS'
	dc	'DEFW'
	dc	'DEFZ'
	dc	'DS'
	dc	'DW'
	dc	'DZ'
	dc	'EQU'
	dc	'ORG'
	dw	0
;
; Register names -- lower-cased because they are extensions of the
; mnemonics in Tab1Z.
;
Tab3Z:	dc	'A'
	dc	'AF'
	dc	'AF'''
	dc	'B'
	dc	'BC'
	dc	'C'
	dc	'D'
	dc	'DE'
	dc	'E'
	dc	'H'
	dc	'HL'
	dc	'I'
	dc	'IX'
	dc	'IY'
	dc	'L'
	dc	'R'
	dc	'SP'
	dw	0
;
; Program-transfer conditions -- lower-cased since they are extensions
; of mnemonics in Tab1Z.
;
Tab4Z:	dc	'C'
	dc	'M'
	dc	'NC'
	dc	'NZ'
	dc	'P'
	dc	'PE'
	dc	'PO'
	dc	'Z'
	dw	0
;
; End statement -- a common table used by both Zilog and Intel modes.
;
Tab5Z:	dc	'END'
	dw	0
;
; Extended Intel Mnemonics -- mnemonics for SLRMAC, LASM3, and Z80.LIB
; macros for MAC and RMAC.
;
; Numeric arguments:
;
;	0	End Of table
;	1	No argument expected
;	2	Symbol or numeric argument
;	3	Use TablI3, registers, for argument casing
;	4	Not used here because Intel branch instructions incorporate
;			conditions into the primary mnemonic.
;
Tab1I:	dc	'ACI'
	db	2
	dc	'ADC'
	db	3
	dc	'ADCX'
	db	2
	dc	'ADCY'
	db	2
	dc	'ADD'
	db	3
	dc	'ADDX'
	db	2
	dc	'ADDY'
	db	2
	dc	'ADI'
	db	2
	dc	'ANA'
	db	3
	dc	'ANDX'
	db	2
	dc	'ANDY'
	db	2
	dc	'ANI'
	db	2
	dc	'BIT'
	db	3
	dc	'BITX'
	db	2
	dc	'BITY'
	db	2
	dc	'CALL'
	db	2
	dc	'CC'
	db	2
	dc	'CCD'
	db	1
	dc	'CCDR'
	db	1
	dc	'CCI'
	db	1
	dc	'CCIR'
	db	1
	dc	'CM'
	db	2
	dc	'CMA'
	db	1
	dc	'CMC'
	db	1
	dc	'CMP'
	db	3
	dc	'CMPX'
	db	2
	dc	'CMPY'
	db	2
	dc	'CNC'
	db	2
	dc	'CNZ'
	db	2
	dc	'CP'
	db	2
	dc	'CPE'
	db	2
	dc	'CPI'
	db	2
	dc	'CPO'
	db	2
	dc	'CZ'
	db	2
	dc	'DAA'
	db	1
	dc	'DAD'
	db	3
	dc	'DADC'
	db	3
	dc	'DADX'
	db	3
	dc	'DADY'
	db	3
	dc	'DCR'
	db	3
	dc	'DCRX'
	db	2
	dc	'DCRY'
	db	2
	dc	'DCX'
	db	3
	dc	'DCXIX'
	db	1
	dc	'DCXIY'
	db	1
	dc	'DI'
	db	1
	dc	'DJNZ'
	db	2
	dc	'DSBC'
	db	3
	dc	'EI'
	db	1
	dc	'EXAF'
	db	1
	dc	'EXX'
	db	1
	dc	'HLT'
	db	1
	dc	'IM0'
	db	1
	dc	'IM1'
	db	1
	dc	'IM2'
	db	1
	dc	'IN'
	db	2
	dc	'IND'
	db	1
	dc	'INDR'
	db	1
	dc	'INI'
	db	1
	dc	'INIR'
	db	1
	dc	'INP'
	db	3
	dc	'INR'
	db	3
	dc	'INRX'
	db	2
	dc	'INRY'
	db	2
	dc	'INX'
	db	3
	dc	'INXIX'
	db	1
	dc	'INXIY'
	db	1
	dc	'JC'
	db	2
	dc	'JM'
	db	2
	dc	'JMP'
	db	2
	dc	'JNC'
	db	2
	dc	'JNZ'
	db	2
	dc	'JP'
	db	2
	dc	'JPE'
	db	2
	dc	'JPO'
	db	2
	dc	'JR'
	db	2
	dc	'JRC'
	db	2
	dc	'JRNC'
	db	2
	dc	'JRNZ'
	db	2
	dc	'JRZ'
	db	2
	dc	'JZ'
	db	2
	dc	'LBCD'
	db	2
	dc	'LDA'
	db	2
	dc	'LDAI'
	db	1
	dc	'LDAR'
	db	1
	dc	'LDAX'
	db	3
	dc	'LDD'
	db	1
	dc	'LDDR'
	db	1
	dc	'LDED'
	db	2
	dc	'LDI'
	db	1
	dc	'LDIR'
	db	1
	dc	'LDX'
	db	3
	dc	'LDY'
	db	3
	dc	'LHLD'
	db	2
	dc	'LIXD'
	db	2
	dc	'LIYD'
	db	2
	dc	'LSPD'
	db	2
	dc	'LXI'
	db	3
	dc	'LXIX'
	db	2
	dc	'LXIY'
	db	2
	dc	'MOV'
	db	3
	dc	'MOVX'
	db	3
	dc	'MOVY'
	db	3
	dc	'MVI'
	db	3
	dc	'MVIX'
	db	2
	dc	'MVIY'
	db	2
	dc	'NEG'
	db	1
	dc	'NOP'
	db	1
	dc	'ORA'
	db	3
	dc	'ORI'
	db	2
	dc	'ORX'
	db	2
	dc	'ORY'
	db	2
	dc	'OUT'
	db	2
	dc	'OUTD'
	db	1
	dc	'OUTDR'
	db	1
	dc	'OUTI'
	db	1
	dc	'OUTIR'
	db	1
	dc	'OUTP'
	db	3
	dc	'PCHL'
	db	1
	dc	'PCIX'
	db	1
	dc	'PCIY'
	db	1
	dc	'POP'
	db	3
	dc	'POPIX'
	db	1
	dc	'POPIY'
	db	1
	dc	'PUSH'
	db	3
	dc	'PUSHIX'
	db	1
	dc	'PUSHIY'
	db	1
	dc	'RAL'
	db	1
	dc	'RALR'
	db	3
	dc	'RALX'
	db	2
	dc	'RALY'
	db	2
	dc	'RAR'
	db	1
	dc	'RARR'
	db	3
	dc	'RARX'
	db	2
	dc	'RARY'
	db	2
	dc	'RC'
	db	1
	dc	'RES'
	db	3
	dc	'RESX'
	db	2
	dc	'RESY'
	db	2
	dc	'RET'
	db	1
	dc	'RETI'
	db	1
	dc	'RETN'
	db	1
	dc	'RLC'
	db	1
	dc	'RLCR'
	db	3
	dc	'RLCX'
	db	2
	dc	'RLCY'
	db	2
	dc	'RLD'
	db	1
	dc	'RM'
	db	1
	dc	'RNC'
	db	1
	dc	'RNZ'
	db	1
	dc	'RP'
	db	1
	dc	'RPE'
	db	1
	dc	'RPO'
	db	1
	dc	'RRC'
	db	1
	dc	'RRCR'
	db	3
	dc	'RRCX'
	db	2
	dc	'RRCY'
	db	2
	dc	'RRD'
	db	1
	dc	'RST'
	db	2
	dc	'RZ'
	db	1
	dc	'SBB'
	db	3
	dc	'SBCD'
	db	2
	dc	'SBCX'
	db	2
	dc	'SBCY'
	db	2
	dc	'SBI'
	db	2
	dc	'SDED'
	db	2
	dc	'SETB'
	db	3
	dc	'SETX'
	db	2
	dc	'SETY'
	db	2
	dc	'SHLD'
	db	2
	dc	'SIXD'
	db	2
	dc	'SIYD'
	db	2
	dc	'SLAR'
	db	3
	dc	'SLAX'
	db	2
	dc	'SLAY'
	db	2
	dc	'SPHL'
	db	1
	dc	'SPIX'
	db	1
	dc	'SPIY'
	db	1
	dc	'SRAR'
	db	3
	dc	'SRAX'
	db	2
	dc	'SRAY'
	db	2
	dc	'SRLR'
	db	3
	dc	'SRLX'
	db	2
	dc	'SRLY'
	db	2
	dc	'SSPD'
	db	2
	dc	'STA'
	db	2
	dc	'STAI'
	db	1
	dc	'STAR'
	db	1
	dc	'STAX'
	db	3
	dc	'STC'
	db	1
	dc	'STX'
	db	3
	dc	'STY'
	db	3
	dc	'SUB'
	db	3
	dc	'SUBX'
	db	2
	dc	'SUBY'
	db	2
	dc	'SUI'
	db	2
	dc	'XCHG'
	db	1
	dc	'XORX'
	db	2
	dc	'XORY'
	db	2
	dc	'XRA'
	db	3
	dc	'XRI'
	db	2
	dc	'XTHL'
	db	1
	dc	'XTIX'
	db	1
	dc	'XTIY'
	db	1
	dw	0
;
; Pseudo-ops -- lower-cased because they are at the heart of the program's
; nature and cause simple one-for-one translation of listed ASCII into
; program and data bytes.  Other pseudo-ops control assembler machinery of
; some complexity; they are upper-cased to stand out.
;
Tab2I:	dc	'ASET'
	dc	'DB'
	dc	'DC'
	dc	'DS'
	dc	'DW'
	dc	'DZ'
	dc	'EQU'
	dc	'ORG'
	dc	'SET'
	dw	0
;
; Register names -- lower-cased because they are extensions of the
; mnemonics in Tab1I.
;
Tab3I:	dc	'A'
	dc	'B'
	dc	'BC'
	dc	'C'
	dc	'D'
	dc	'DE'
	dc	'E'
	dc	'H'
	dc	'HL'
	dc	'IX'
	dc	'IY'
	dc	'L'
	dc	'M'
	dc	'PSW'
	dc	'SP'
	dw	0
;
; Program-transfer conditions -- lower-cased since they are extensions
; of mnemonics in Tab1I.  For Intel mnemonics there are no condition tests
; because the mnemonics incorporate them.
;
Tab4I:	dw	0
;
; Search Table -- used to search file initially to find a recognizable
; opcode.
;
TableX:	dc	'LD'
	db	1Ah
	dc	'LXI'
	db	0Ch
	dc	'MOV'
	db	0Ch
	dc	'MVI'
	db	0Ch
	dw	0
;
BakTyp:	db	'BAK'
TmpTyp:	db	'$$$'
;
; Uninitialized data . . .
;
	DSEG
;
Table1:	ds	2		; Table addresses depending on mode
Table2:	ds	2
Table3:	ds	2
Table4:	ds	2
Table5:	ds	2
;
InFcb:	ds	36		; input file control block
OutFcb:	ds	36		; output file control block
OutNam:	ds	12		; outfile name storage
StpTmp:	ds	5		; temporary create date storage
;
TabTyp:	ds	1		; 'Z'=Zilog, 'I'=Intel, else default
OpQFlg:	ds	1		; FFh=quiet mode
OpcChk:	ds	1		; 0=opcodes not yet tested for Intel/Zilog
EofFlg:	ds	1		; if nonzero, CpmEof (^Z)
EndFlg:	ds	1		; if nonzero, read error (CpmEof)
RecCnt:	ds	1		; current buffer record count
Buffer:	ds	2		; buffer address
DmaAdr:	ds	2		; current DMA address
BufPtr:	ds	2		; current buffer pointer
BufLim:	ds	2		; buffer limit address
NegOfs:	ds	2		; start offset from beginning of buffer
DftUsr:	ds	1		; default user at invocation
DftDsk:	ds	1		; ..and default drive
InUsr:	ds	1		; infile user
InDsk:	ds	1		; ..and infile drive
OutUsr:	ds	1		; outfile user
OutDsk:	ds	1		; ..and outfile drive
	ds	100h		; stack
Stack:	ds	2		; old stack pointer
;
	end