;  PROGRAM:	Z33FCP
;  AUTHOR:	Jay Sage
;  VERSION:	1.0
;  DATE:	May 25, 1987
;  DERIVATION:	FCP10 by Jay Sage (ZSIG)

; ZCPR33 is copyright 1987 by Echelon, Inc.  All rights reserved.  End-user
; distribution and duplication permitted for non-commercial purposes only.
; Any commercial use of ZCPR33, defined as any situation where the duplicator
; recieves revenue by duplicating or distributing ZCPR33 by itself or in
; conjunction with any hardware or software product, is expressly prohibited
; unless authorized in writing by Echelon.

;=============================================================================
;
;			R E V I S I O N    H I S T O R Y
;
;=============================================================================

;  05/25/87	Created ZCPR33 version from the code I released through ZSIG.
;    1.0	This code differs only in the more efficient way in which it
;		determines if it was invoked with a directory prefix that
;		signals that the transient IF.COM should be used to process
;		the IF command.  This permits the user to force the use of a
;		more powerful option processor in the transient IF.COM than in
;		the resident code.  Option bytes were added after the end of
;		the resident option dispatch table so that SHOW can report
;		configuration options to the user.
;
;  FCP10 notes
;
;		The transient processor can now be loaded at an address other
;		than 100h so as not to interfere with code loaded in the TPA.
;		Then the GO command can normally be used even after IF.COM is
;		used to process the flow test.  If the LOADCHK equate
;		is true then the FCP will verify that the transient
;		processor has been loaded to the page in memory for which
;		it was assembled.  If loaded to the wrong page, it will
;		be reloaded to the correct one.
;
;		The test for the form ARG1=ARG2 was tightened up so as not to
;		be confused by an equal sign in some later part of the command
;		tail (e.g., "IF REG 1 = 2").  Now only the first token
;		(contiguous string of characters) is checked.  This extra code
;		is under the control of the XEQOPT equate.  The only option
;		that is still a problem is the COMIF form '~='.  Since the '='
;		is in the first token, this 'not equal' condition cannot be
;		distinguished from an equality test against the character '~'.
;		The solution is to turn off equality testing in the resident FCP
;		or to use the alternative COMIF options 'NE' or '~EQ' for this
;		test.
;
;		Added optional commands AND and OR.  These work like IF except
;		that they affect the current IF level rather than going one
;		level deeper.
;
;		Added optional command ZIF to zero out all IF states no matter
;		whether current state is true or false (XIF only works if state
;		is true.
;
;		Added new optional command IFQ (if-query) and enhanced the
;		IFSTAT code that is invoked when the NOISE equate is true.
;		In both cases, the entire tree of IF states is now shown,
;		starting with the current level.  For example, IFQ might result
;		in the display "IF FTT" (we are at third IF level and it is
;		false; the second and first IF levels are true).  If the
;		current IF level is 0, then the display is "IF None".
;
;		Added two new resident options: AMBIGUOUS (AM) returns true if
;		the file specification in the second token has a '?' (or '*')
;		in it; COMPRESSED (CO) returns true if the file specificaton in
;		the second token has a 'Z' or a 'Q' in the second character of
;		the file type.
;
;		Howard Goldstein contributed significantly to the development
;		of this code.  Bridger Mitchell also offered helpful
;		suggestions.
;
;					Jay Sage
;
;  Notes from earlier SYSFCP revisions
;
;  09/12/85	Fixed bug in my code used when IF.COM is found in a specified
;		drive/user area.  The values of CDISK and CUSER were not being
;		set, and as a result the user was not returned to the correct
;		directory.  The EXIST and EMPTY tests did not work correctly
;		unless a DIR: or DU: was given explicitly with each file name.
;					Jay Sage

;  08/29/85	Reorganized code so that COMIF code handles only those
;		options not in the table of local IF functions.  Also changed
;		code to allow searching for IF.COM in a specified directory
;		instead of using the ROOT of the path.	Also renamed macros
;		to make code ZAS compatible.
;					Jay Sage

;  07/21/85	Corrected reversed sensing of program error flag in the
;		IF ERROR test.
;					Jay Sage

;  01/02/85	Revised to correct a bug in the IF EMPTY test.	First, the
;		current record byte was not being set to zero before trying
;		to read from the file.	Secondly, the test for error was not
;		testing for FF but for 00.  My BDOS does not return 0 for
;		success.  It seems to return 00, 01, 02, or 03.  This made the
;		file appear to be empty.
;					Jay Sage

;=============================================================================
;
;		M A C R O S    A N D    E Q U A T E S
;
;=============================================================================

; External macro references

	maclib	z3base.lib	; Source of system addresses
	maclib	z33fcp.lib	; Source of configuration options
	maclib	z33mac.lib	; Z33 macros

; Equates section

version	equ	10

lf	equ	0ah
cr	equ	0dh
bell	equ	07h

base	equ	0
wboot	equ	base+0000h	; CP/M warm boot address
udflag	equ	base+0004h	; User num in high nybble, disk in low
bdos	equ	base+0005h	; BDOS function call entry point
tfcb	equ	base+005ch	; Default FCB buffer
fcb1	equ	tfcb		; 1st and 2nd FCBs
fcb2	equ	tfcb+16
tbuff	equ	base+0080h	; Default disk I/O buffer
tpa	equ	base+0100h	; Base of TPA

;=============================================================================

; Start of code

	org	fcp		; From Z3BASE

	db	'Z3FCP'		; Flag for Package Loader

;=============================================================================
;
;			C O M M A N D	 T A B L E
;
;=============================================================================

; The command name table is structured as follows:
;
;	The first byte is the number of characters in each command name.
;	Next come records consisting of command names followed by entry
;	point addresses for the code to process the command.  Finally,
;	there is a null to indicate the end of the dispatch table.

	db	cmdsize		; Size of text entries
ctab:	ctable			; Macro defined in Z33FCP.LIB
	db	0

;=============================================================================
;
;		I F    C O N D I T I O N    O P T I O N S
;
;=============================================================================

condtab:

	 if	ifotrue
	db	'T '		; TRUE
	dw	ifctrue
	db	'F '		; FALSE
	dw	ifcfalse
	 endif	; ifotrue

	 if	ifambig		; Ambiguous file spec
	db	'AM'
	dw	ifcambig
	 endif	; ifambig

	 if	ifcompr		; Squeezed or crunched
	db	'CO'
	dw	ifccompr
	 endif	; ifcompr

	 if	ifoempty
	db	'EM'		; File empty
	dw	ifcempty
	 endif	; ifoempty

	 if	ifoerror
	db	'ER'		; Error message
	dw	ifcerror
	 endif	; ifoerror

	 if	ifoexist
	db	'EX'		; File exists
	dw	ifcex
	 endif	; ifoexist

	 if	ifoinput
	db	'IN'		; User input
	dw	ifcinput
	 endif	; ifoinput

	 if	ifonull
	db	'NU'
	dw	ifcnull
	 endif	; ifonull

	 if	ifotcap		; Z3 TCAP available
	db	'TC'
	dw	ifctcap
	 endif	; ifotcap

	 if	ifowheel	; Wheel Byte
	db	'WH'
	dw	ifcwheel
	 endif	; ifowheel

	db	0

; Option bytes: these option bytes can be used to convey information to
; programs such as SHOW.  The first one is used to reduce the chance of
; misinterpreting data from an earlier version of the FCP that does not
; have the option bytes.  The next byte tells if COMIF has been activated
; and if the root of the path will be used as the directory in which to look
; for IF.COM.  If PATHROOT is not selected (or if the path is empty), then
; the specified drive/user will be used.  The overflow bit in case the user
; number is greater than 15 is kept in bit 2 of the second option byte.  The
; combined user/drive value is kept in the third option byte.

highuser defl	ifusr gt 15

opt0:	db	33h		; ZCPR33 version ID
opt1:	optflag	highuser,pathroot,comif
opt2:	db [ ifusr and 0fh ] shl 4 + [ ifdrv - 'A' ]	; user/drive flag

;=============================================================================
;
;		C O M M A N D	 P R O C E S S I N G	C O D E
;
;=============================================================================

; Command: ZIF
;
;	This command zeros out the IF system no matter what the current
;	level IF state is.

	 if	zifopt

ifzero:
	 if	noise
	call	nl		; Print new line
	 endif	; noise

	jr	ifexit1

	 endif	; zifopt

;-----------------------------------------------------------------------------

; Command: XIF
;
;	If current IF state is true, XIF terminates all IFs, restoring a basic
;	TRUE state.

ifexit:
	 if	noise
	call	nl		; Print new line
	 endif	; noise

	call	iftest		; See if current IF is running and FALSE

	 if	noise
	jr	z,ifstat	; Abort with status message if so
	 else	; not noise
	ret	z		; Or just return if false
	 endif	; noise

ifexit1:
	ld	hl,z3msg+1	; Pt to IF flag
	xor	a		; A=0
	ld	(hl),a		; Zero IF flag
	jr	ifendmsg	; Print message

;-----------------------------------------------------------------------------

; Command: FI
;
;	FI decrements to the previous IF level.  It does this by shifting the
;	current-if-bit in the first 'if' message in the Z3MSG buffer right one
;	position.

ifend:
	 if	noise
	call	nl		; Print new line
	 endif	; noise

	ld	hl,z3msg+1	; Point to IF flag
	ld	a,(hl)		; Get it
	or	a		; No IF active?
	jr	z,ifnderr

ifendmsg:
	 if	noise
	call	print
	db	'To',' '+80h	; Prefix to status display
	 endif	; noise

	srl	(hl)		; Adjust active bit

	 if	noise
	jr	nz,ifstat	; Print status if IF still active
	 endif	; noise

ifnderr:
	 if	noise

	call	print		; Print message
	db	'No',' '+80h
	jp	prif

	 else	; not noise

	ret

	 endif	; noise

;-----------------------------------------------------------------------------

; Command: ELSE
;
;	ELSE complements the Active Bit for the Current IF provided the
;	previous IF state was true.  If the previous state was false, the
;	command is flushed.
;
;	This is accomplished according to the following algorithm.  If the
;	current IF is 0 (no IF) or 1 (one IF), then take the previous state
;	to be true and perform the toggle.  Otherwise, test the previous
;	IF level condition and toggle only if it is true.

ifelse:
	 if	noise and [not ifqopt]
	call	nl		; Print new line
	 endif	; noise and [not ifqopt]

	call	msgbf1		; Get current if
	ld	b,a		; Save in B
	srl	a		; Back up if pointer bit to previous IF level
	jr	z,iftog		; If no previous IF level, go to toggle code
	and	(hl)		; Determine state of previous IF level

	 if	noise
	if	ifqopt
	jr	z,ifstat0	; Print status on new line
	else
	jr	z,ifstat	; If false, just print status
	endif			; Ifqopt
	 else	; not noise
	ret	z		; Or simply return
	 endif	; noise

iftog:
	ld	a,(hl)		; Get if-status message byte
	xor	b		; Flip current state
	ld	(hl),a		; Put result back in message byte
				; ..and fall thru to print status

	 if	not noise
	ret
	 endif

;-----------------------------------------------------------------------------

; Indicate if current IF is True or False

	 if	ifqopt or [noise and [andopt or oropt]]

ifstat0:
	call	nl

	 endif	; ifqopt or [noise and [andopt or oropt]]

	 if	noise or ifqopt

ifstat:

	call	prif

	call	msgbf1		; Get current if byte and set flags
	ld	b,a		; Get it into B
	jr	nz,ifstat1	; Nz means if active

	call	print
	db	'Non','e'+80h
	ret

ifstat1:
	ld	a,(hl)		; Get if-status message byte
	and	b		; Mask in currently active IF level status
	ld	c,'F'		; Load with false indicator
	jr	z,ifstat2	; If current IF is false, jump
	ld	c,'T'		; Else, load with true indicator
ifstat2:
	ld	a,c
	call	conout

	srl	b		; Drop one IF level
	jr	nz,ifstat1	; Loop through all IF states
	ret

	 endif	; noise or ifqopt

;-----------------------------------------------------------------------------

;  Console Output Routine

conout:
	push	hl		; Save regs
	push	de
	push	bc
	push	af
	and	7fh		; Clear msb
	ld	e,a		; Char in E
	ld	c,2		; Output
	call	bdos
	pop	af		; Get regs
	pop	bc
	pop	de
	pop	hl
	ret

;-------------------------

;  Output CRLF

nl:
	call	print
	db	cr,lf+80h
	ret

;-----------------------------------------------------------------------------

; Command:  OR

;	This command performs a logical or operation by updating the
;	if state without going to a new level.  If there are active
;	IFs and the current state is true, we do nothing.  Else we back
;	up one level and fall through to normal IF processing.

	if	oropt

orstart:
	call	msgbf1		; Get if active byte
	jr	z,backup	; Treat like if if no IFs active
	and	(hl)		; Check current state
	jr	z,backup	; Current STATE false so go proecess

	if	noise
	jr	ifstat0		; Else return and show status
	else
	ret			; Or just return

	endif			; Noise
	endif		; Oropt

;-----------------------------------------------------------------------------

; Command:  AND

;	This command performs a logical and operation by updating the
;	if state without going to a new level.  If there are active
;	IFs and the current state is false, we do nothing.  Else we back
;	up one level and fall through to normal IF processing.

	if	andopt

andstart:
	call	iftest		; Test for IF running and false
	if	noise
	jr	z,ifstat0	; Condition met, show status & return
	else
	ret	z		; Condition met, return
	endif			; Noise
	endif		; Andopt

; Common stuff for and and or

	if andopt or oropt

backup:
	dec	hl		; Pt to flag byte
	srl	(hl)		; Drop back one level
;
; Poke "IF" into external fcb for transient
;
	if	comif
pokefcb:
	ld	de,extfcb+1	; Pt to external fcb
	ld	hl,ifcmd	; Pointer to IF command in table
	ld	bc,cmdsize	; Length
	ldir			; Move it in

	endif			; comif

;	Fall through to IF PROCESSING
	endif			;Andopt or oropt

;-----------------------------------------------------------------------------

; FCP Command: IF
;
;	If current IF state is false, then advance to next level and set it
;	to false also.  If current IF state is true, then test condition and
;	set the next level accordingly.

ifstart:
	 if	noise
	call	nl		; Print new line
	 endif	; noise

	call	iftest		; See if current IF is running and FALSE
	jr	z,ifcf


; Test for presence of colon in command.  If colon present, then go directly
; to COMIF processing.


	 if	comif

	ld	a,(extfcb)	; Check drive byte of external FCB
	or	a		; If it is zero, no colon was present
	jp	nz,runcomif	; If colon, go to comif processing
				; Else fall through to resident code
	 endif	; comif

;-----------------------------------------------------------------------------
;
;	R E S I D E N T    C O M M A N D    P R O C E S S I N G
;
;-----------------------------------------------------------------------------

resident:

; Test for Equality if Equal Sign in Token

	 if	ifoeq

	ld	hl,tbuff+1

	 if	xeqopt		; Extended equal testing

skipsp:				; Skip over any space to first token
	ld	a,(hl)
	or	a		; Check for end of tail
	jr	z,ifck0		; If so , go on
	cp	' '+1		; Test for space or control character
	jr	nc,tsteq	; If not, we are at first token
	inc	hl		; Otherwise advance to next character
	jr	skipsp		; ..and continue testing

	 endif	; xeqopt

tsteq:
	ld	a,(hl)		; Get character from command tail
	inc	hl		; Point to next one
	or	a		; EOL?
	jr	z,ifck0		; Continue if so

	 if	xeqopt
	cp	' '+1		; End of token?
	jr	c,ifck0		; If so, go on
	 endif	; xeqopt

	cp	'='		; Found '=' ?
	jr	nz,tsteq	; If not, continue scan

	ld	hl,fcb1+1	; Else, get ready to compare FCBs
	ld	de,fcb2+1
	ld	b,11		; 11 bytes
eqtest:
	ld	a,(de)		; Compare
	cp	(hl)
	jr	nz,ifcf
	inc	hl		; Pt to next
	inc	de
	djnz	eqtest
	jr	ifct

	 endif	; ifoeq


ifck0:
	ld	de,fcb1+1	; Point to first character in FCB1

	 if	ifoneg
	ld	a,(de)		; Get it
	ld	(negflag),a	; Set negate flag
	cp	negchar		; Is it a negate?
	jr	nz,ifck1	; If not, go on
	inc	de		; Else point to character after negchar
ifck1:
	 endif	; ifoneg

	 if	iforeg		; REGISTERS
	call	regtest		; Test for register value
	jr	nz,runreg
	 endif	; iforeg

	call	condtest	; Test of condition match
	jr	nz,runcond	; If found, process condition

	 if	comif
	jp	runcomif	; If function not found in table, use transient
	else

	call	print		; Beep to indicate error
	db	bell+80h

	 if	noise
	jp	ifstat		; No condition, display current condition
	 else	; no noise
	ret
	 endif	; noise
	 endif	; comif

;-----------------------------------------------------------------------------
;
; Process register - register value is in A
;
;-----------------------------------------------------------------------------

	 if	iforeg
runreg:
	push	af		; Save value
	call	getnum		; Extract value in FCB2 as a number
	pop	af		; Get value
	cp	b		; Compare against extracted value
	jr	jrtrue		; True if match; false if not
	 endif	; iforeg

;-----------------------------------------------------------------------------
;
; Process conditional test - address of conditional routine is in HL
;
;-----------------------------------------------------------------------------

runcond:
	jp	(hl)		; "call" routine pted to by HL

;=============================================================================
;
;		R E S I D E N T    C O N D I T I O N    O P T I O N S
;
;=============================================================================

; Condition:  AMBIGUOUS

	 if	ifambig

ifcambig:
	ld	hl,fcb2+1	; Scan FCB2 for a '?' character
	ld	bc,11		; Characters to scan
	ld	a,'?'		; Reference character
	cpir
	jr	jrtrue		; True if '?' found; false if not

	 endif	; ifambig

;-----------------------------------------------------------------------------

; Condition:  COMPRESSED

	 if	ifcompr

ifccompr:
	ld	a,(fcb2+10)	; Get middle character of file type
	cp	'Z'		; Crunched
	jr	z,ifctrue
	cp	'Q'		; Squeezed
	jr	jrtrue

	 endif	; ifcompr

;-----------------------------------------------------------------------------

; Condition:  TRUE
;	IFCTRUE  enables an active IF
; Condition:  FALSE
;	IFCFALSE enables an inactive IF

	 if	ifoempty or ifoerror or ifoexist or ifowheel
jrfalse:
	jr	z,ifcfalse
	 endif	; Ifoempty or ifoerror or ifoexist or ifowheel

ifctrue:

	 if	ifoneg
	call	negtest		; Test for negate
	jr	z,ifcf
	 endif	; ifoneg

ifct:
	ld	b,0ffh		; Active
	jp	ifset

	 if	iforeg or ifambig or ifcompr or ifoinput or ifonull
jrtrue:
	jr	z,ifctrue
	 endif	; Iforeg or ifambig or ifcompr or ifoinput or ifonull

ifcfalse:

	 if	ifoneg
	call	negtest		; Test for negate
	jr	z,ifct
	 endif	; ifoneg

ifcf:
	ld	b,0		; Inactive
	jp	ifset

;-----------------------------------------------------------------------------

; Condition: EMPTY filename.typ

	 if	ifoempty
ifcempty:
	call	tlog		; Log into FCB2's DU
	ld	de,fcb2		; Pt to fcb2
	ld	c,15		; Open file
	push	de		; Save fcb ptr
	call	bdos
	pop	de
	inc	a		; Not found?
	jr	z,ifctrue
	ld	c,20		; Try to read a record
	xor	a		; <JPS> set cr value to zero
	ld	(fcb2+32),a	; <JPS> to attempt to read first record
	call	bdos
	or	a		; 0=OK
	jr	jrfalse		; true if no read
	 endif	; ifoempty

;-----------------------------------------------------------------------------

; Condition: ERROR

	 if	ifoerror
ifcerror:
	ld	a,(z3msg+6)	; Get error byte
	or	a		; 0=FALSE (no error registered)
	jr	jrfalse
	 endif	; ifoerror

;-----------------------------------------------------------------------------

; Condition: EXIST filename.typ

	 if	ifoexist
ifcex:
	call	tlog		; Log into DU
	ld	de,fcb2		; Pt to fcb
	ld	c,17		; Search for first
	call	bdos
	inc	a		; Set zero if error
	jr	jrfalse
	 endif			; Ifoexist

;-----------------------------------------------------------------------------

; Condition: INPUT (from user)

	 if	ifoinput
ifcinput:
	ld	hl,z3msg+7	; Pt to ZEX message byte
	ld	(hl),10b	; Suspend ZEX input
	push	hl		; Save ptr to ZEX message byte

	 if	not noise
	call	nl
	 endif	; not noise

	call	prif
	call	print
	db	'True?',' '+80h
	ld	c,1		; Input from console
	call	bdos
	pop	hl		; Get ptr to ZEX message byte
	ld	(hl),0		; Return ZEX to normal processing
	cp	' '		; Yes?
	jr	z,ifctrue
	and	5fh		; Mask and capitalize user input
	cp	'T'		; True?
	jr	z,ifctrue
	cp	'Y'		; Yes?
	jr	z,ifctrue
	cp	cr		; Yes?
	jr	jrtrue

	 endif	; ifoinput

;-----------------------------------------------------------------------------

; Condition:  NULL (2nd file name)

	 if	ifonull
ifcnull:
	ld	a,(fcb2+1)	; Get first char of 2nd file name
	cp	' '		; Space = null
	jr	jrtrue
	 endif	; ifonull

;-----------------------------------------------------------------------------

; Condition:  TCAP

	 if	ifotcap
ifctcap:
	ld	a,(z3env+80h)	; Get first char of Z3 TCAP Entry
	cp	' '+1		; Space or less = none
	jr	c,ifcfalse
	jr	ifctrue
	 endif	; ifotcap

;-----------------------------------------------------------------------------

; Condition:  WHEEL

	 if	ifowheel
ifcwheel:
	ld	hl,(z3env+29h)	; Get address of wheel byte
	ld	a,(hl)		; Get byte
	or	a		; Test for true
	jr	jrfalse	; False if 0
	 endif	; ifowheel

;=============================================================================
;
;		S U P P O R T    R O U T I N E S
;
;=============================================================================

; Convert chars in FCB2 into a number in B

	 if	iforeg
getnum:
	ld	b,0		; Set number
	ld	hl,fcb2+1	; Pt to first char
getn1:
	ld	a,(hl)		; Get char
	inc	hl		; Pt to next
	sub	'0'		; Convert to binary
	ret	c		; Done if error
	cp	10		; Range?
	ret	nc		; Done if out of range
	ld	c,a		; Value in C
	ld	a,b		; A=old value
	add	a,a		; *2
	add	a,a		; *4
	add	a,b		; *5
	add	a,a		; *10
	add	a,c		; Add in new digit value
	ld	b,a		; Result in B
	jr	getn1		; Continue processing
	 endif	; iforeg

;-----------------------------------------------------------------------------

; Log into DU in FCB2

	 if	ifoexist or ifoempty

tlog:
	ld	a,(fcb2)	; Get disk
	or	a		; Current?
	jr	nz,tlog1
	ld	c,25		; Get disk
	call	bdos
	inc	a		; Increment for following decrement
tlog1:
	dec	a		; A=0
	ld	e,a		; Disk in E
	ld	c,14
	call	bdos
	ld	a,(fcb2+13)	; Pt to user
	ld	e,a
	ld	c,32		; Set user
	jp	bdos

	 endif	; ifoexist or ifoempty

;-----------------------------------------------------------------------------

; Test of Negate Flag = negchar

	 if	ifoneg
negtest:
negflag	equ	$+1		; Pointer for in-the-code modification
	ld	a,0		; 2nd byte is filled in
	cp	negchar		; Test for No
	ret
	 endif	; ifoneg

;-----------------------------------------------------------------------------

; Test FCB1 against a single digit (0-9)
;  Return with register value in A and NZ if so

	 if	iforeg
regtest:
	ld	a,(de)		; Get digit
	sub	'0'
	jr	c,zret		; Z flag for no digit
	cp	10		; Range?
	jr	nc,zret		; Z flag for no digit
	ld	hl,z3msg+30h	; Pt to registers
	add	a,l		; Pt to register
	ld	l,a
	ld	a,h		; Add in H
	adc	0
	ld	h,a
	xor	a		; Set NZ
	dec	a
	ld	a,(hl)		; Get register value
	ret
zret:
	xor	a		; Set Z
	ret
	 endif	; iforeg

;-----------------------------------------------------------------------------

; Test to see if a current IF is running and if it is FALSE
;   If so, return with Zero Flag Set (Z)
;   If not, return with Zero Flag Clear (NZ)
; Affect only HL and PSW

iftest:
	call	msgbf1		; Test for active IF
	jr	z,ifok		; No active IF
	and	(hl)		; Check active flag
	ret	z		; Return Z since IF running and FALSE
ifok:
	xor	a		; Return NZ for OK
	dec	a
	ret

msgbf1:
	ld	hl,z3msg+1	; Get IF active flag
	ld	a,(hl)
	inc	hl		; Pt to If status byte
	or	a		; Set z if no IF active
	ret

;-----------------------------------------------------------------------------

; Test FCB1 against condition table (must have 2-char entries)
;  Return with routine address in HL if match and NZ flag

condtest:
	ld	hl,condtab	; Pt to table
condt1:
	ld	a,(hl)		; End of table?
	or	a
	ret	z
	ld	a,(de)		; Get char
	cp	(hl)		; Comppare entries
	inc	hl		; Pt to next
	inc	de
	jr	nz,condt2
	ld	a,(de)		; Get 2nd char
	cp	(hl)		; Compare
	jr	nz,condt2
	inc	hl		; Pt to address
	ld	a,(hl)		; Get address in HL
	inc	hl
	ld	h,(hl)
	ld	l,a		; HL = address
	jr	ifok		; Set NZ for OK
condt2:
	inc	hl		; Pt to next entry
	inc	hl		; Skip over addr
	inc	hl
	dec	de		; Pt to 1st char of condition
	jr	condt1

;-----------------------------------------------------------------------------

; Turn on next IF level
;   B register is 0 if level is inactive, 0FFH if level is active

ifset:
	ld	hl,z3msg+1	; Get IF flag
	ld	a,(hl)
	or	a		; If no if at all, start 1st one
	jr	z,ifset1
ifset0:
	add	a,a		; Advance to next level
	jr	c,iferr		; Check for overflow (8 IFs max)
	ld	(hl),a		; Set IF byte
	jr	ifset2
ifset1:
	inc	a		; A=1
	ld	(hl),a		; Set 1st IF
ifset2:
	ld	d,a		; Get IF byte
	and	b		; Set interested bit
	ld	b,a
	inc	hl		; Pt to active flag
	ld	a,d		; Complement IF byte
	cpl
	and	(hl)		; Mask in only uninterested bits
	or	b		; Mask in interested bit
	ld	(hl),a		; Save result

	 if	noise
	jp	ifstat		; Print status and exit
	else
	ret			; Or just exit
	 endif	; noise

iferr:
	call	print		; Beep to indicate overflow
	db	bell+80h
	ret

;=============================================================================
;
;		T  R A N S I E N T    I F    P R O C E S S I N G
;
;=============================================================================


	 if	comif

runcomif:

; First we have to find IF.COM

	 if	pathroot

	ld	bc,100h*[ifdrv-'A'] + ifusr	; Values to use if null path
	ld	hl,expath	; Point to symbolic path

fndroot:
	ld	a,(hl)		; Check for end of path
	or	a
	jr	z,froot2	; If end, branch

; Process Next Path Element

	cp	curint		; Current disk/user symbol?
	jr	nz,froot0	; If not, branch
	ld	a,(curdr)	; Get current disk
	inc	a		; Compensate for following decrement
froot0:
	dec	a		; Shift to range 0..15
	ld	b,a		; Set disk
	inc	hl		; Point to user in path
	ld	a,(hl)		; Get user
	cp	curint		; Current drive/user symbol?
	jr	nz,froot1	; If not, branch
	ld	a,(curusr)	; Get current user
froot1:
	ld	c,a		; Set user
	inc	hl		; Point to next element in symbolic path
	jr	fndroot

; Done with Search - BC Contains ROOT DU (or specified DU if path is empty)

	else	; not pathroot

	ld	bc,100h*[ifdrv-'A'] + ifusr	; Used specified DU

	 endif	; pathroot

froot2:
	call	logbc		; Log into IF.COM's directory

; Try to Open File IF.COM

	ld	de,comifadr	; Set DMA to scratch address
	call	setdma

	ld	de,extfcb	; Point to command FCB
	xor	a
	ld	(de),a		; Force current drive
	ld	c,15		; Open file
	call	bdos
	inc	a
	jr	nz,ifload	; Branch if file found

; IF.COM not found - process as IF F

ifnotfnd:
	call	iferr		; Ring bell
	call	reset		; Return home
	jp	ifcf

; Load File IF.COM

ifload:
	call	readcmd		; Read record from file
	jr	nz,ifnotfnd	; If eof, treat as if file not found
	ld	a,(comifadr+8)	; Get environment type
	cp	3		; If not type 3
	jr	nz,ifnotfnd	; ..treat as if file not found
	ld	hl,(comifadr+0bh) ; Get type-3 execution address into HL
	xor	a		; Reset current record value to 0
	ld	(extfcb+20h),a	; ..to start reading again from beginning

; Read in the file

	push	hl		; Save execution address on stack
ifload1:
	push	hl		; Save loading address
	ex	de,hl		; Set DMA address
	call	setdma
	call	readcmd		; Read a record from file	
	pop	hl		; Get current loading address back
	jr	nz,ifload2	; Branch if done reading
	ld	de,80h		; Advance it by one record
	add	hl,de
	jr	ifload1		; Back to read some more

; Reset Environment (DMA and DU) and Run IF.COM

ifload2:
	call	reset		; Reset DMA and directory
	ld	hl,z3env	; Call IF.COM with HL pointing to ENV
	ret			; Run IF.COM (execution address on stack)

; Reset DMA and Current DU

reset:
	ld	de,80h		; Reset DMA address
	call	setdma
	ld	bc,(curusr)	; Return home

; Log Into DU in BC

logbc:
	ld	e,b		; Set disk
	push	bc
	ld	c,14		; Select disk
	call	bdos
	pop	bc
	ld	e,c		; Set user
	ld	c,32		; Select user
	jp	bdos

; Set DMA to address in DE register

setdma:
	ld	c,26
	jp	bdos

; Read a record from file in EXTFCB

readcmd:
	ld	de,extfcb
	ld	c,20
	call	bdos
	or	a		; Set NZ if error (end of file)
	ret

	 endif	; comif

;=============================================================================
;
;		U T I L I T Y    S U B R O U T I N E S
;
;=============================================================================

;  Print " IF"

prif:
	call	print
	db	'IF',' '+80h
	ret

;-----------------------------------------------------------------------------

;  Print String (terminated in 0 or MSB Set) at Return Address

print:
	ex	(sp),hl		; Get address
	call	print1
	ex	(sp),hl		; Put address
	ret

;  Print String (terminated by MSB Set) pted to by HL

print1:
	ld	a,(hl)		; Done?
	inc	hl		; Pt to next
	call	conout		; Print char
	or	a		; Set msb flag (m)
	ret	m		; Msb terminator
	jr	print1

;=============================================================================
;
; Test for Size Error

	 if	[$ gt [fcp + fcps*128]]
	***  FCP is too large  ***
	 endif

	end