; Program:	NZFCP
; Date:		October 9, 1989
; Author:	Carson Wilson <crw>
; Version:	1.3
; Changes:	Updated & improved JetLDR signon.
;		Changed four JR's to JP's.

;  Date:	August 21, 1988
;  Author:	Carson Wilson
;  Version:	1.2

;  Derived from:

;  Date:	April 1988
;  Name changed and code modified for NZ-COM.

;  Derived from:

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

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

;=============================================================================
;
;			R E V I S I O N    H I S T O R Y
;
;=============================================================================
;
;  21 Aug 88	Added JetLDR signon description.
;		IF IN now prints ' (Y/N)? ', and accepts only Y or y or
;		N or n.
;		Added macro code to show FCP length following assembly.
;
;					Carson Wilson.
;
;  6 April 88	Handles latest Type 4 IF.COM
;    1.2	Changed command tail loader to accept :IF.  Joe Wright
;
;  12/31/87	Modified for use with Z34CMN.LIB for NZ-COM.  Joe Wright.
;    1.1
;
;  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
;
;=============================================================================

	name	('FCP')

; External macro references

	maclib	Z34CMN.LIB	; Source of system addresses
	maclib	NZFCP.LIB	; Source of configuration options
	maclib	Z34MAC.LIB	; Z34 macros

; Equates section

version	equ	13

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


;=============================================================================
;
;		J e t L D R    S I G N - O N
;
;=============================================================================

; This prints an extended ID message upon loading with JetLDR.
; These are NOT the command names.

	COM	/_ID_/

	db	'Copyright 1989 ZSA',cr,lf
	db	'Commands:',cr,lf
	db	' IF ELSE FI XIF '

	 if	andopt
	db	'AND '
	 endif
	 if	oropt
	db	'OR '
	 endif
	 if	ifqopt
	db	'IFQ '
	 endif
	 if	zifopt
	db	'ZIF '
	 endif

	db	cr,lf,'Options'
	 if	ifoneg
	db	' (use "',negchar,'" to negate)'
	 endif
	 if	noise
	db	'; (noise)'
	 endif
	db	':',cr,lf

	 if	ifotrue
	db	' T F '
	 endif
	 if	ifambig
	db	'AMbig '
	 endif
	 if	ifcompr
	db	'COmpr '
	 endif
	 if	ifoempty
	db	'EMpty '
	 endif
	 if	ifoeq
	db	'x=y '
	 endif
	 if	ifoerror
	db	'ERror '
	 endif
	 if	ifoexist
	db	'EXist '
	 endif
	 if	ifoinput
	db	'INput '
	 endif
	 if	ifonull
	db	'NUll '
	 endif
	 if	iforeg
	db	'REgs '
	 endif
	 if	ifotcap
	db	'TCap '
	 endif
	 if	ifowheel
	db	'WHeel '
	 endif

	 if	comif
	db	cr,lf,' Use '
	 if	pathroot
	db	'root:'
	 endif
	db	'IF.COM'
	 endif

	db	0		; End of JetLDR sign-on message

	CSEG

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

; Start of code

start:
	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 NZFCP.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	34h		; ZCPR34 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
	ld	(hl),0		; 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?

	call	msgbf1
	dec	hl		; Save a byte over the three lines above

	jr	z,ifnderr

ifendmsg:
	 if	noise
	call	print
	dc	'To '		; 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
	dc	'No '
	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

ifstat0:
	call	nl
ifstat:
	call	prif		; Print 'IF '
	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
	dc	'None'
	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

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

;  Output CRLF

nl:	call	print
	dc	cr,lf
	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	not ifqopt

	ld	a,(extfcb)	; NZ if explicit
	ld	hl,tbuff
	or	(hl)
	jp	z,ifstat0	; Report IF status

	 endif	; not ifqopt

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

	call	iftest		; See if current IF is running and FALSE
	jP	z,ifcf		; Yes, do the right thing

; 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 processing
	 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
	dc	bell

	 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)

; Modified to say " (Y/N)? ", and accept ONLY Y or y or N or n
; Carson Wilson  3/1/88

	 if	ifoinput
ifcinput:
	call	print
	dc	' (Y/N)? '
ifcinp1:
	ld	hl,z3msg+7	; Pt to ZEX message byte
	ld	(hl),10b	; Suspend ZEX input
	push	hl		; Save ptr to ZEX message byte
ifcinp2:
	ld	e,0ffh
	ld	c,6		; Direct input from console
	call	bdos
	or	a		; Any input yet?
	jr	z,ifcinp2	; Nope, try again

	pop	hl		; Get ptr to ZEX message byte
	ld	(hl),0		; Return ZEX to normal processing
	and	5fh		; Mask and capitalize user input
	cp	'Y'
	jr	nz,testN	; No, check if 'N'
	call	conout		; Display 'Y'
	jr	ifctrue		; Process as true
testN:
	cp	'N'
	jr	nz,notN		; Not 'N' or 'n'
	call	conout		; Display 'N'
	jr	ifcfalse	; Process as false
notN:
	ld	a,bell		; Protest!
	call	conout
	jr	ifcinp1		; Force either Y or y or N or n

	 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
	jP	c,ifcfalse
	jP	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
	jP	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:
	or	255		; Return NZ for OK
	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

	call	msgbf1
	dec	hl

	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
	dc	bell
	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

	ld	bc,100h*(ifdrv-'A')+ifusr ; Values to use if null path

	 if	pathroot

	ld	hl,(expath)	; Point to symbolic path (indirect)
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)

	 endif	; pathroot

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

; Try to Open File IF.COM

	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	defdma		; First record to tbuff
	call	readcmd		; Read 1st record from IF.COM
	jr	nz,ifnotfnd	; If eof, treat as if file not found

	ld	(extfcb+32),a	; Start from scratch (record 0)
	ld	a,(tbuff+8)
	cp	3
	jr	c,ifnotfnd	; Only Types 3 and 4 are acceptable

	call	loadif		; Load IF.COM and set IFADR appropriately
;
; Build the command tail at tbuff
;
	ld	de,tbuff	; Point DE to tbuff
	push	de		; Save it for later
	ld	hl,(z3msg+4)	; Points into MCL buffer
;
; Advance HL to first 'space' after IF or .IF or :IF
;
advsp:	inc	hl
	ld	a,(hl)
	cp	' '+1		; Carry if space or null
	jr	nc,advsp

	ld	c,0		; Clear a counter

putt:	inc	de		; Advance tbuff pointer
	ld	a,(hl)		; From MCL
	ld	(de),a		; To tbuff
	inc	hl		; Advance MCL pointer
	or	a		; Check for null
	jr	z,putx		; End of command line
	cp	';'		; Command separator
	jr	z,putx		; End of command
	inc	c		; Count it up
	jr	putt		; Next..

putx:	xor	a		; Get a null
	ld	(de),a		; Terminate the line in tbuff
	pop	hl		; Beginning of tbuff
	ld	(hl),c		; Character count
;
; Pick up the execution address for Type 3 or 4
;
	ld	hl,(ifadr)	; Load address
	ld	a,(hl)		; First byte at load address
	cp	0c7h		; Test for RST 0
	jr	nz,runif	; Nope, execute it
	ld	(hl),0c3h	; Plug in a JP
;
; Arrive here to execute IF.COM
;
runif:	ld	hl,z3env	; Pass environment in HL
	db	0c3h		; JP instruction
ifadr:	dw	0		; Load/Execution address of IF.COM

;
; Load IF.COM
;
loadif:
	ld	hl,(tbuff+11)	; Type 3 load address
	jr	z,loada		; Load as Type 3
;
; Assume Type 4 (or higher)
;
	ld	hl,extfcb+32	; Point to CR of extfcb
	ld	(hl),2		; Set up for record 2
	push	hl		; Save the pointer
	call	readcmd		; Get it into tbuff
	pop	hl
	jp	nz,ifnotfnd	; Too short
	ld	(hl),a		; Record 0 again
	ld	hl,(tbuff+11)	; Size word
	push	hl		; Save it
	call	readcmd		; Read record 0 again
	pop	bc		; Size
	ld	de,(ccp)	; CCP start
	ld	hl,z3env
	dec	a		; Phony fullget flag
	call	tbuff+9		; Call Type 4 loader
	push	hl		; Save load address
	call	readcmd		; Read record 1 to tbuff (point to record 2)
	pop	hl		; Load address
;
loada:	ld	(ifadr),hl	; Save it
;
; Load IF.COM to (HL) until end of file, reset DMA and DU and return
;
load:	push	hl		; Save loading address
	call	setdma		; According to HL
	call	readcmd		; Read a record from file
	pop	hl		; Get current loading address back
	jr	nz,reset	; End of file
	ld	de,128		; Advance it by one record
	add	hl,de
	jr	load		; Back to read some more

; Reset DMA and Current DU

reset:	call	defdma
	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 default DMA address

defdma:	ld	hl,tbuff

; Set DMA to address according to HL

setdma:	push	hl		; Save it
	ex	de,hl		; To DE
	ld	c,26		; Set DMA command
	call	bdos		; Do it
	pop	hl		; DMA address
	ret

; 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
	dc	'IF '
	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

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

;  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

;=============================================================================
;
; Display current length in records
;
prtval	macro m1,v1,m2,v2,m3
	.radix 10
	.printx	m1 v1 m2 v2 m3
	endm

length	equ	$ - start
recs	equ	length / 128
bytes	equ	length mod 128
 
	.printx
	prtval <FCP is now>,%recs,<records and>,%bytes,<bytes long.>
	.printx

	end

; End of NZFCP.Z80