title '//IF.ASM Conditional Processor for Submit'
;
; by Gary Novasielski. ver 1.0
;
; 2.1	(86/10/16) $$$.SUB file always on A0:, for CCP+ 2.1 up
; 2.0	(85/10/20) handles lower case command lines (as can be
;	 supplied by CCPLUS).	C.B. Falconer.
;
version	equ	21
;
@msg	set	9
@ver	set	12
@opn	set	15
@cls	set	16
@del	set	19
@frd	set	20
@cur	set	25
@dma	set	26
@usr	set	32
@siz	set	35
query	equ	0ffh;		CPM enquiry argument
;
cpmbase	equ	0
boot	set	cpmbase
bdos	set	boot+5
tfcb	equ	boot+5ch
tfcb1	equ	tfcb
tfcb2	equ	tfcb+16
tbuff	equ	boot+80h
tpa	equ	boot+100h
ctrl	equ	' '-1;		Ctrl char mask
cr	set	ctrl and 'M'
lf	set	ctrl and 'J'
tab	set	ctrl and 'I'
false	set	0
true	set	not false
;
cpm	macro	func,operand
	if	not nul operand
	 lxi	d,operand
	endif;;		of not nul operand
	if	not nul func
	 mvi	c,@&func
	endif
	call	bdos
	endm
;
fcbs2	equ	14
fcbrc	equ	15
fcbr0	equ	33;	Offsets into File Control Blocks
fcbr1	equ	34
fcbr2	equ	35
;
;--------------------------------------------------------------
	org	tpa
;
ifprog:	jmp	pastc
	db	' V', version/10+'0', '.', version mod 10+'0'
	db	' Copyright (c) 1982 Gary P. Novosielski '
	db	ctrl and 'Z'
;
pastc:	lxi	h,0;		Clear HL
	dad	sp;		Get stack pointer value
	lxi	sp,lclstak;	Set local stack
	push	h;		Save old SP on new stack.
	mvi	a,query
	call	sgusr
	sta	user;		save entry user #
;	"	"
; Scan the command buffer to find the option list
; which is defined as everything following the last
; colon on the line which is preceded by a space.
	lxi	h,tbuff;	Point to command buffer
	mov	a,m;		Get the count byte
	inr	a;		Character after the last...
	mov	c,a;		(save in c)
	add	l;		...use as index into buffer
	mov	l,a
	adc	h
	sub	l
	mov	h,a
;	"	"
	mvi	m,0;		Insist on 0 terminator.
;	"	"		 It's there already, but
;	"	"		 not documented.
; Check for option list.
srchop:	dcr	c;		Out of characters?
	jz	nolist;		No option list found.
	dcx	h;		Next previous character.
	mov	a,m;		To accumulator
	call	upshft;		ensure upper case
	cpi	':';		Is it a colon?
	cz	srch1;		If yes, check preceding space.
	jz	fndops;		Ok, found the option list.
	jmp	srchop;		option list not found yet
;
nolist:	mvi	a,true
	sta	optn;		Treat as an option
	jmp	finscn
;
; Check for preceding space.
srch1:	mov	a,c;		Index to register A
	sui	2;		At position 2 or better?
	rc;			Leading colon? Very strange.
	dcx	h;		Point to preceding character
	mov	a,m;		Get it
	inx	h;		Point back to colon
	call	upshft;		ensure upshifted
	cpi	' ';		Was it a space?
	ret;			Return the flags
;
;
; The option list has been located.
; Scan off the options and set bytes accordingly
fndops:
scnops:	inx	h;		Point to next option char
	mov	a,m;		Move it to A
	call	upshft;		ensure upshifted
	ora	a;		if it's a zero...
	jz	finscn;		there are no more
;	"	"
; Check and set valid options
	cpi	'A';		Try first possibility
	jnz	nota;		Nope
	sta	opta;		Yes, set option flag
	jmp	scnops;		Do remaining options.
;
nota:	cpi	'C';		Try next possibility
	jnz	notc;		Nope
	sta	optc;		Yes, set option flag
	jmp	scnops;		Do remaining options.
;
notc:	cpi	'D';		Try next possibility
	jnz	notd;		Etc.
	sta	optd
	jmp	scnops
;
notd:	cpi	'E'
	jnz	note
	sta	opte
	jmp	scnops
;
note:	cpi	'M'
	jnz	notm
	sta	optm
	jmp	scnops
;
notm:	cpi	'P'
	jnz	notp
	sta	optp
	jmp	scnops
;
notp:	cpi	'U'
	jnz	notu
	sta	optu
	jmp	scnops
;
notu:	cpi	'0'
	jnz	not0
	sta	opt0
	jmp	scnops
;
not0:	cpi	'1'
	jnz	not1
	sta	opt1
	jmp	scnops
;
not1:	cpi	'2'
	jnz	not2
	sta	opt2
	jmp	scnops
;
invalid:
not2:	sta	badopt;		Save the offender
	cpm	msg,badmsg;	Print the message
;	"	"
abend:	xra	a
	call	sgusr;		subfile ops on user 0
	cpm	del,subfile;	Cancel the Jobstream
	cpm	msg,canmsg;	Print cancel message
	call	suser;		Restore entry user
	jmp	boot;		Boot the system
;
badmsg:	db	'Option "'
badopt:	db	0
	db	'" invalid.'
	db	'$'
;
canmsg:	db	'...CANCELED'
	db	'$'
;
; The option list has been scanned
; Now check the active ones in a logical order.
finscn:	lda	optd;		Option D
	ora	a;		if set means 
	cnz	drvsub;		Drive substitution.
;	"	"
	lda	opta;		Option A
	ora	a;		if set means
	cnz	chka;		Ambiguous spec required.
	jc	evalfls;	(false condition if not met)
;	"	"
	lda	optu;		Option U
	ora	a;		if set means
	cmc
	cnz	chka;		Unambiguous spec required.
	jnc	evalfls;	(false if ambiguous)
;	"	"
	lda	opt0;		Option 0
	ora	a;		if set means
	cnz	chk0;		drives must match
	jc	evalfls
;	"	"
	lda	opt1;		Option 1
	ora	a;		if set means
	cnz	chk1;		names must match
	jc	evalfls
;	"	"
	lda	opt2;		Option 2
	ora	a;		if set means
	cnz	chk2;		extensions (types) must match
	jc	evalfls
;	"	"
	lda	optc;		Option C
	ora	a;		if set means
	cnz	chkc;		Contents are required
	jc	evalfls
;	"	"
	lda	opte;		Option E
	ora	a;		if set means
	cnz	chke;		Must be empty (or missing)
	jc	evalfls
;	"	"
	lda	optp;		Option P
	ora	a
	cnz	chkp;		Presence required (C or E)
	jc	evalfls
;	"	"
	lda	optm;		Option M
	ora	a
	cmc
	cnz	chkp;		must be Missing (not P)
	jnc	evalfls
;	"	"
	lda	optn;		No option list means
	ora	a
	cnz	chkn;		Any parm ok except blank
	jc	evalfls
;	"	"
; The tests have all evaluated true.
; do the next line in the submit file. In other words, do nothing.
evaltru:
;	"	"
exit:	call	suser;		Restore entry user
	pop	h;		Old stack pointer
	sphl;			Reset to entry stack
	ret;			Return to CCP
;
; At least one test failed. Remove the next line from the submit file.
evalfls:
	xra	a
	call	sgusr;		Do subfile operations on user #0
	cpm	opn,subfile;	Open the $$$.SUB file.
	inr	a;		Test return code.
	jz	suberr;		Not within a .SUB file??
	lxi	h,subfile+fcbrc; Record counter for the extent
	dcr	m;		 decreases by one.
	jm	suberr;		No following line??
 	dcx	h;		The S2 byte just below it
	mvi	m,0;		 is zeroed to mark file altered.
	cpm	cls,subfile;	Write change to directory.
	inr	a;		Trouble?
	jz	suberr
	jmp	exit;		Ok, all finished.
;
; Something is wrong with the $$$.SUB file.
suberr:	cpm	msg,submsg;	Inform user
	jmp	abend;		bail out.
;
submsg:	db	'Error accessing .SUB file.'
	db	'$'
;
; Here are the routines which do the actual condition checks.
; All of them return with the zero flag set if the condition
; tested is true, and with the carry flag set if false.
; a,f
retcy:	xra	a
	sui	1
	ret
;
drvsub:;	Not really a test, just move drive spec from
;	parm1 to parm2 for use in other tests
;	lda	tfcb1
;	sta	tfcb1
;	ret;			leave zero flag set
;
; see if parm1 is ambiguous
chka:	lxi	h,tfcb1+1;	start at name
	mvi	a,'?';		check for "?". No need to
;	"	"		 check for * since CCP
;	"	"		 has done expansion.
	mvi	c,8+3;		'xxxxxxxxyyy'
chka01:	cmp	m;		is this one a wildcard?
	rz;			True return
	inx	h;		Point to next one
	dcr	c;		count down
	jnz	chka01;		Keep testing till done.
	jmp	retcy;		False return
;
; see if drives match.
;
chk0:	cpm	cur;		Find out current default
	inr	a;		Drive A becomes 1
	mov	d,a;		Default in D
	lda	tfcb1
	ora	a;		See if Parm1 says default
	jnz	chk001
	mov	a,d;		Substitute current default
chk001:	mov	b,a;		Save Parm1 drive in B
	lda	tfcb2
	ora	a;		See if Parm2 says default
	jnz	chk002
	mov	a,d
chk002:	cmp	b;		compare with Parm 1
	rz;			return true
	jmp	retcy;		return false
;
; Compare name fields for a match.
;
chk1:	lxi	h,tfcb1+1
	lxi	d,tfcb2+1
	mvi	c,8
chk101: ldax	d;		get parm2 char
	cpi	'?';		chk wild
	jz	chk102;		treat as match
	mov	b,a
	mov	a,m;		get parm1 char
	cpi	'?';		chk wild
	jz	chk102;		treat as match
	cmp	b;		compare 1 with 2
	jnz	retcy;		Return false
chk102:	inx	d
	inx	h
	dcr	c
	jnz	chk101;		Ok so far, keep going
	xra	a;		clear carry, set zero
	ret
;
; Compare filetypes as above
;	
chk2:	lxi	h,tfcb1+1+8
	lxi	d,tfcb2+1+8
	mvi	c,3;		Shorter length
	jmp	chk101;		 otherwise same algorithm
;
; Check directory for file
;	
chkp:	cpm	opn,tfcb
	inr	a;		test return code
	jz	retcy;		return false 
	xra	a;		else
	ret;			return true
;
; Check file contents
;	
chkc:	call	chka;		Ambiguity is meaningless
	jz	retcy
	call	chkp;		Must be present, of course
	rc
chkc01:	cpm	ver;		check version
	cpi	20h;		2.0 or better?
	jc	chkc14;		No, can't use size function
chkc20:	xra	a
	sta	tfcb+fcbr2;	Clear high record byte
	cpm	siz,tfcb;	Compute file size
	lxi	h,tfcb+fcbr0
	mov	a,m
	inx	h
	ora	m
	inx	h
	ora	m;		zero set if empty
	jz	retcy;		return false
 	xra	a;		return true
	ret
;
; Version 1.4 or older CP/M.  Just do a read.
chkc14:	cpm	dma,tbuff
	cpm	frd,tfcb;	Read Sequential
	ora	a;		Test code
	rz;			return true
	stc;			return false
	ret
;
; Check for empty file
;	
chke:	call	chka;		Still must be unambiguous
	jz	retcy
	call	chkp;		If missing, call it empty
	jc	retzro
	call	chkc01;		check for contents
	jz	retcy;		return false (not empty)
	xra	a
	ret;			return true  (empty)
;
; check for any hint of a parm1 entry
;	
chkn:	lda	tfcb;		Point to drive spec
	ora	a
	jnz	retzro;		Return true for any drive
	lda	tfcb+1	
	cpi	' '
	jnz	retzro;		Return true for any name
	lda	tfcb+9
	cpi	' '
	jz	retcy;		No type either.  False
retzro:	xra	a
	ret
;
; Upshift (a) if lower case.  Carry if upshifted, else a unchanged
; a,f
upshft:	cpi	'z' + 1
	rnc;			not lower case
	cpi	'a'
	cmc
	rnc
	adi	'A'-'a';	causes carry
	ret
;
; reset user #
suser:	lda	user
;	"	"
; set/get user (a)
sgusr:	mov	e,a
	cpm	usr
	ret
;
; +-----------------------------+
; |	Working Storage		|
; +-----------------------------+
;
opta:	db	0;		default options not selected
optc:	db	0
optd:	db	0
opte:	db	0
optm:	db	0
optn:	db	0
optp:	db	0
optu:	db	0
opt0:	db	0
opt1:	db	0
opt2:	db	0
;
; File Control Block for submit file.
subfile:
	db	1;		Drive A:
	db	'$$$     SUB'
	db	0,0,0,0
	ds	subfile-$+36;	Remainder of 36 bytes
;
user	ds	1;		User no. on entry
;
; Local Stack area
	ds	48
lclstak equ	$
;
	end	ifprog