RomWBW/Source/Images/d_bp/u15/IF.MAC

;
; Program: IF
; Author: Richard Conn
; Modified By: Charles McManis
; Version: 1.2
; Date: 11 Feb 85
; Previous Versions:  1.1 (22 Apr 84)
;
version	equ	12

;
;	IF is intended to be invoked from the IF routine in an FCP.
; This program implements the IF conditional tests and sets the next level
; of IF to be TRUE or FALSE.
; 
; Modified on 02/11/85 to accept ambiguous file names and match them. This 
; allows aliases to add file extensions if they are needed, for instance 
; if there is an alias LDIR that gets a directory of an .LBR file, it 
; previously had to be defined as an example :
; 
;

;
; Equates for Key Values
;
z3env	SET	0f400h	;address of ZCPR3 environment
noise	equ	0	;set to 1 for noisey (message) operation
negchar	equ	'~'	;negation prefix char
bdos	equ	5
fcb1	equ	5ch
fcb2	equ	6ch
tbuff	equ	80h
cr	equ	0dh
lf	equ	0ah
bel	equ	07h

;
; External Z3LIB and SYSLIB Routines
;
	ext	z3init,strtzex,stopzex,geter1,getreg,ift,iff,getenv
	ext	eval10,print,capine,codend,sksp,sknsp,zfname,cout

;
; Environment Definition
;
	if	z3env ne 0
;
; External ZCPR3 Environment Descriptor
;
	jmp	start
	db	'Z3ENV'	;This is a ZCPR3 Utility
	db	1	;External Environment Descriptor
z3eadr:
	dw	z3env
start:
	lhld	z3eadr	;pt to ZCPR3 environment
;
	else
;
; Internal ZCPR3 Environment Descriptor
;
	MACLIB	Z3BASE.LIB
	MACLIB	SYSENV.LIB
z3eadr:
	jmp	start
	SYSENV
start:
	lxi	h,z3eadr	;pt to ZCPR3 environment
	endif

;
; Start of Program -- Initialize ZCPR3 Environment
;
	call	z3init	;initialize the ZCPR3 Environment
	jmp	ifstart
;
; Condition Table
;
condtab:
	db	'T '		;TRUE
	dw	ifctrue
	db	'F '		;FALSE
	dw	ifcfalse
	db	'EM'		;file empty
	dw	ifcempty
	db	'ER'		;error message
	dw	ifcerror
	db	'EX'		;file exists
	dw	ifcex
	db	'IN'		;user input
	dw	ifcinput
	db	'NU'		;null argument
	dw	ifcnull
	db	'TC'		;Z3TCAP Entry Loaded
	dw	ifctcap
	db	'WH'		;Wheel Byte
	dw	ifcwheel
	db	0

;
; FCP Extension Command: IF
;
ifstart:
;
; Advance to Next Line if Noisey
;
	IF	NOISE
	mvi	a,lf
	call	cout
	ENDIF		;NOISE
;
; Test for Equal Sign in Line and Process FCB1=FCB2 form if so
;
	lxi	h,tbuff+1	;pt to buffer
ifteq:
	mov	a,m		;look for =
	inx	h		;pt to next
	ora	a		;done if EOL
	jz	ifck0
	cpi	'='		;equal?
	jnz	ifteq
	lxi	h,fcb1+1	;= found, so compare FCB1 and FCB2
	lxi	d,fcb2+1
	mvi	b,11		;11 chars
ifteq1:
	ldax	d		;compare
; ** Such a small change really.
	cpi	'?'		; see if an AFN was specified
	jz	okchar		; always match a ?
	mov	c,a		; save it in C temporarily
	mov	a,m		; get the other character
	cpi	'?'		; see if it is a ?
	jz	okchar		; if so accept it as a match
	cmp	c
; ** This allows IF $1=* and IF $1=*.?q? etc
;	cmp	m		; this guy is no longer needed.
	jnz	ifcf		;FALSE if no match
okchar:
	inx	h		;advance
	inx	d
	dcr	b		;count down
	jnz	ifteq1
	jmp	ifct		;TRUE if match
;
; Test Condition in FCB1 and file name in FCB2
;   Execute condition processing routine
;
ifck0:
	lxi	d,fcb1+1	;pt to first char in FCB1
	ldax	d		;get it
	cpi	'/'		;help?
	jz	ifhelp
	cpi	' '		;also help
	jz	ifhelp
	sta	negflag		;set negate flag
	cpi	negchar		;is it a negate?
	jnz	ifck1
	inx	d		;pt to char after negchar
ifck1:
	call	regtest		;test for register value
	jnz	runreg
	call	condtest	;test of condition match
	jnz	runcond		;process condition
	IF	NOISE
	call	print
	db	' No IF Condition Given',0
	ret
	ELSE		;NOT NOISE
	mvi	a,bel
	jmp	cout
	ENDIF		;NOISE
;
; Print Help Message
;
ifhelp:
	IF	NOT NOISE
	mvi	a,lf	;leading new line
	call	cout
	ENDIF		;NOT NOISE
	call	print
	db	'IF, Version '
	db	(version/10)+'0','.',(version mod 10)+'0'
	db	' - Conditional Test'
	db	cr,lf,'Syntax:'
	db	cr,lf,'	IF condition arguments -or- IF ~condition arguments'
	db	cr,lf,'where a leading "~" negates the effect of the '
	db	'IF Condition'
	db	cr,lf,'Possible IF Conditions are:'
	db	cr,lf,'	T			Always TRUE'
	db	cr,lf,'	F			Always FALSE'
	db	cr,lf,'	EMPTY <file list>	T if Files are Empty'
	db	cr,lf,'	ERROR			T if Error Flag Set'
	db	cr,lf,'	EXIST <file list>	T if Files Exist'
	db	cr,lf,'	INPUT			T if User Hits T, Y, CR, or SP'
	db	cr,lf,'	NULL arg		T if No Arg Follows'
	db	cr,lf,'	TCAP			T if ZCPR3 TCAP Available'
	db	cr,lf,'	WHEEL			T if Wheel Byte Set'
	db	cr,lf,'	reg value		T if Register reg = value'
	db	cr,lf,'	fcb1=fcb2		T if the Two FCB values are ='
	db	cr,lf,'Only first 2 letters of keywords are required'
	db	cr,lf,'The leading "~" is effective with all conditions except'
	db	' fcb1=fcb2'
	db	0
	ret
;
; Process register - register value is in A
;
runreg:
	push	psw		;save value
	call	getnum		;extract value in FCB2 as a number
	pop	psw		;get value
	cmp	b		;compare against extracted value
	jz	ifctrue		;TRUE if match
	jmp	ifcfalse	;FALSE if non-match
;
; Process conditional test - address of conditional routine is in HL
;
runcond:
	pchl			;"call" routine pted to by HL

;
; Condition:  NULL (2nd file name)
;
ifcnull:
	lda	fcb2+1		;get first char of 2nd file name
	cpi	' '		;space = null
	jz	ifctrue
	jmp	ifcfalse

;
; Condition:  TCAP
;
ifctcap:
	call	getenv		;get ptr to ZCPR3 environment descriptor
	lxi	d,80h		;pt to TCAP entry
	dad	d
	mov	a,m		;get first char
	cpi	' '+1		;space or less = none
	jc	ifcfalse
	jmp	ifctrue

;
; Condition:  WHEEL
;
ifcwheel:
	call	getenv		;get ptr to ZCPR3 environment descriptor
	lxi	d,29h		;pt to Wheel Byte address
	dad	d
	mov	a,m		;get low
	inx	h
	mov	h,m		;get high
	mov	l,a		;put low
	mov	a,m		;get Wheel Byte
	ora	a		;0=not wheel
	jz	ifcfalse
	jmp	ifctrue

;
; Condition:  TRUE
;	IFCTRUE  enables an active IF
; Condition:  FALSE
;	IFCFALSE enables an inactive IF
;
ifctrue:
	call	negtest	;test for negate
	jz	ifcf	;make IF FALSE
ifct:
	IF	NOISE
	call	print
	db	' IF T',0
	ENDIF		;NOISE
	call	ift	;make IF TRUE
	rnz
	jmp	ifovfl
ifcfalse:
	call	negtest	;test for negate
	jz	ifct	;make IF TRUE
ifcf:
	IF	NOISE
	call	print
	db	' IF F',0
	ENDIF		;NOISE
	call	iff	;make IF FALSE
	rnz
ifovfl:
	IF	NOISE
	call	print
	db	' IF Overflow',0
	ret
	ELSE		;NOT NOISE
	mvi	a,bel
	jmp	cout
	ENDIF		;NOISE

;
; Condition: INPUT (from user)
;
ifcinput:
	IF	NOT NOISE
	mvi	a,lf		;new line
	call	cout
	ENDIF		;NOT NOISE
	call	stopzex		;suspend ZEX input
	call	print
	db	' IF True? ',0
	call	capine
	call	strtzex		;resume ZEX input
	cpi	'T'		;true?
	jz	ifctrue
	cpi	'Y'		;yes?
	jz	ifctrue
	cpi	cr		;new line?
	jz	ifctrue
	cpi	' '		;space?
	jz	ifctrue
	jmp	ifcfalse

;
; Condition: EXIST filename.typ
;	List of Files Permitted
;
ifcex:
	call	skip2	;skip to 2nd token
	jz	ifctrue	;declare TRUE if none
;
; Extract Next File
;
ifcex1:
	lxi	d,fcb1	;pt to FCB
	call	zfname	;convert text
	push	h	;save ptr to next char
;
; Log Into to DU and Search for File
;
	call	tlog	;log into DU
	lxi	d,fcb1	;pt to fcb
	mvi	c,17	;search for first
	call	bdos
	inr	a	;set zero if error
;
; Abort as FALSE if File Not Found
;
	pop	h	;get ptr to next char
	jz	ifcfalse
;
; Advance to Next File, if Any
;
	mov	a,m	;more to follow?
	inx	h
	cpi	','
	jz	ifcex1
;
; All Files Exist if No More Files
;
	jmp	ifctrue	;all found, so TRUE

;
; Condition: EMPTY filename.typ
;
ifcempty:
	call	skip2	;skip to 2nd token
	jz	ifctrue	;TRUE if none
;
; Select Next File
;
ifcem1:
	lxi	d,fcb1	;pt to FCB1
	call	zfname	;convert
	push	h	;save ptr to next
;
; Log into DU and Try to Open File
;
	call	tlog		;log into FCB1's DU
	lxi	d,fcb1		;pt to fcb1
	mvi	c,15		;open file
	push	d		;save fcb ptr
	call	bdos
	pop	d
	inr	a		;not found?
;
; File is Empty if Not Found
;
	jz	ifemt
;
; Try to Read one Record from File
;
	mvi	c,20		;try to read a record
	call	bdos
	ora	a		;0=OK
;
; File is Empty if Can't Read Record
;
	jnz	ifemt		;NZ if no read
	pop	h		;file not empty
;
; File Exists and Contains Something
;
	jmp	ifcfalse	;so EMPTY condition is FALSE
;
; File is Empty - Advance
;
ifemt:
	pop	h		;pt to next char
	mov	a,m		;get next char
	inx	h
	cpi	','		;more to come?
	jz	ifcem1
;
; Done and True if No More Files - All are Empty
;
	jmp	ifctrue		;all empty, so TRUE

;
; Condition: ERROR
;
ifcerror:
	call	geter1		;get error byte
	jz	ifctrue
	jmp	ifcfalse

;
; **** Support Routines ****
;

;
; Save TBUFF and skip to 2nd token
;
skip2:
	lxi	d,tbuff+1	;pt to first char
	call	codend		;pt to free area
skip2a:
	ldax	d		;get next char
	mov	d
	ora	a		;done?
	jnz	skip2a
	call	codend		;skip over spaces
	call	sksp
	call	sknsp		;skip over 1st token
	call	sksp		;skip over spaces
	mov	a,m		;get 1st char of 2nd token
	ora	a		;return with Z if none
	ret

;
; Convert chars in FCB2 into a number in B
;
getnum:
	lxi	h,fcb2+1	;pt to first char
	call	eval10	;evaluate
	mov	b,a	;value in B
	ret

;
; Log into DU in FCB1
;
tlog:
	lda	fcb1	;get disk
	ora	a	;current?
	jnz	tlog1
	mvi	c,25	;get disk
	call	bdos
	inr	a	;increment for following decrement
tlog1:
	dcr	a	;A=0
	mov	e,a	;disk in E
	mvi	c,14
	call	bdos
	lda	fcb1+13	;pt to user
	mov	e,a
	mvi	c,32	;set user
	jmp	bdos

;
; Test of Negate Flag = negchar
;
negtest:
	lda	negflag		;get flag
	cpi	negchar		;test for No
	ret

;
; Test FCB1 against a single digit (0-9)
;  Return with register value in A and NZ if so
;
regtest:
	ldax	d		;get digit
	sui	'0'
	jc	zret		;Z flag for no digit
	cpi	10		;range?
	jnc	zret		;Z flag for no digit
	mov	b,a		;register number in B
	call	getreg		;get register value
	mov	b,a		;save value
	xra	a		;set NZ
	dcr	a
	mov	a,b		;get register value
	ret
zret:
	xra	a		;set Z
	ret

;
; Test FCB1 against condition table (must have 2-char entries)
;  Return with routine address in HL if match and NZ flag
;
condtest:
	lxi	h,condtab	;pt to table
condt1:
	mov	a,m		;end of table?
	ora	a
	rz
	ldax	d		;get char
	mov	b,m		;get other char in B
	inx	h		;pt to next
	inx	d
	cmp	b		;compare entries
	jnz	condt2
	ldax	d		;get 2nd char
	cmp	m		;compare
	jnz	condt2
	inx	h		;pt to address
	mov	a,m		;get address in HL
	inx	h
	mov	h,m
	mov	l,a		;HL = address
	xra	a		;set NZ for OK
	dcr	a
	ret
condt2:
	lxi	b,3		;pt to next entry
	dad	b		; ... 1 byte for text + 2 bytes for address
	dcx	d		;pt to 1st char of condition
	jmp	condt1

;
; Buffers
;
negflag:
	ds	1		;negation flag

	end