;
;  PROGRAM:  SYSFCP.ASM
;  AUTHOR:  JAY SAGE
;  VERSION:  1.4
;  DATE:  12 SEPTEMBER, 1985
;  PREVIOUS VERSIONS:  1.0 (Ricard Conn), 1.3 (Jay Sage)
;

;  09/12/85	Fixed bug in 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.
;
;  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.  <JPS>

;  07/21/85	Corrected reversed sensing of program error flag in the
;		IF ERROR test. <JPS>

;  01/02/85	Revised by Jay Sage 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.  New code and changes are marked by <JPS>.

VERSION	EQU	13		;<JPS>

;
;  Global Library which Defines Addresses for SYSTEM
;
	MACLIB	Z3BASE	; USE BASE ADDRESSES
	MACLIB	SYSFCP	; USE EQUATES FROM HEADER FILE

;
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 PT
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
;
;$-MACRO 		;FIRST TURN OFF THE EXPANSIONS
;
; MACROS TO PROVIDE Z80 EXTENSIONS
;   MACROS INCLUDE:
;
;	BR	- JUMP RELATIVE
;	BRC	- JUMP RELATIVE IF CARRY
;	BRNC	- JUMP RELATIVE IF NO CARRY
;	BRZ	- JUMP RELATIVE IF ZERO
;	BRNZ	- JUMP RELATIVE IF NO ZERO
;	DBNZ	- DECREMENT B AND JUMP RELATIVE IF NO ZERO
;
;	@GENDD MACRO USED FOR CHECKING AND GENERATING
;	8-BIT JUMP RELATIVE DISPLACEMENTS
;
@GENDD	MACRO	?DD	;;USED FOR CHECKING RANGE OF 8-BIT DISPLACEMENTS
	IF [?DD GT 7FH] AND [?DD LT 0FF80H]
	DB	100H	;Displacement Range Error
	ELSE
	DB	?DD
	ENDIF		;;RANGE ERROR
	ENDM
;
;
; Z80 MACRO EXTENSIONS
;
BR	MACRO	?N	;;JUMP RELATIVE
	IF	I8080	;;8080/8085
	JP	?N
	ELSE		;;Z80
	DB	18H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
BRC	MACRO	?N	;;JUMP RELATIVE ON CARRY
	IF	I8080	;;8080/8085
	JP	C,?N
	ELSE		;;Z80
	DB	38H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
BRNC	MACRO	?N	;;JUMP RELATIVE ON NO CARRY
	IF	I8080	;;8080/8085
	JP	NC,?N
	ELSE		;;Z80
	DB	30H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
BRZ	MACRO	?N	;;JUMP RELATIVE ON ZERO
	IF	I8080	;;8080/8085
	JP	Z,?N
	ELSE		;;Z80
	DB	28H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
BRNZ	MACRO	?N	;;JUMP RELATIVE ON NO ZERO
	IF	I8080	;;8080/8085
	JP	NZ,?N
	ELSE		;;Z80
	DB	20H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
DBNZ	MACRO	?N	;;DECREMENT B AND JUMP RELATIVE ON NO ZERO
	IF	I8080	;;8080/8085
	DEC	B
	JP	NZ,?N
	ELSE		;;Z80
	DB	10H
	@GENDD	?N-$-1
	ENDIF		;;I8080
	ENDM
;
;  SYSTEM Entry Point
;
	org	fcp		; passed for Z3BASE

	db	'Z3FCP'		; Flag for Package Loader
;
;  **** Command Table for FCP ****
;	This table is FCP-dependent!
;
;	The command name table is structured as follows:
;
;	ctable:
;		DB	'CMNDNAME'	; Table Record Structure is
;		DW	cmndaddress	; 8 Chars for Name and 2 Bytes for Adr
;		...
;		DB	0	; End of Table
;
cnsize	equ	4		; NUMBER OF CHARS IN COMMAND NAME
	db	cnsize	; size of text entries
ctab:
	db	'IF  '
	dw	ifstart
	db	'ELSE'
	dw	ifelse
	db	'FI  '
	dw	ifend
	db	'XIF '
	dw	ifexit
	db	0
;
; Condition Table
;
condtab:
;
	IF	IFOTRUE
	db	'T '		;TRUE
	dw	ifctrue
	db	'F '		;FALSE
	dw	ifcfalse
	ENDIF
;
	IF	IFOEMPTY
	db	'EM'		;file empty
	dw	ifcempty
	ENDIF
;
	IF	IFOERROR
	db	'ER'		;error message
	dw	ifcerror
	ENDIF
;
	IF	IFOEXIST
	db	'EX'		;file exists
	dw	ifcex
	ENDIF
;
	IF	IFOINPUT
	db	'IN'		;user input
	dw	ifcinput
	ENDIF
;
	IF	IFONULL
	db	'NU'
	dw	ifcnull
	ENDIF
;
	IF	IFOTCAP		;Z3 TCAP available
	db	'TC'
	dw	ifctcap
	ENDIF
;
	IF	IFOWHEEL	;Wheel Byte
	db	'WH'
	dw	ifcwheel
	ENDIF
;
	db	0

;
;  Print " IF"
;
prif:
	call	print
	db	'IF',' '+80h
	ret
;
;  Print String (terminated in 0 or MSB Set) at Return Address
;
print:
	IF	NOISE
	ld	a,' '		;print leading space
	call	conout
	ENDIF		;NOISE
	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
	br	print1

;
;  **** FCP Routines ****
;  All code from here on is FCP-dependent!
;

;
; FCP Command: XIF
;   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
	brz	ifstat		;abort with status message if so
	ld	hl,z3msg+1	;pt to IF flag
	xor	a		;A=0
	ld	(hl),a		;zero IF flag
	br	ifendmsg	;print message

;
; FCP Command: FI
;   FI decrements to the previous IF
;
;   Algorithm:
;	Rotate Current IF Bit (1st IF Message) Right 1 Bit Position
;
ifend:
	IF	NOISE
	call	nl		;print new line
	ENDIF		;NOISE
	ld	hl,z3msg+1	;pt to IF flag
	ld	a,(hl)		;get it
	or	a		;no IF active?
	brz	ifnderr
ifendmsg:
	IF	NOISE
	push	af		;save A
	call	print
	db	'T','o'+80h	;prefix to status display
	pop	af		;get A
	ENDIF		;NOISE
	rrca			;move right 1 bit
	and	7fh		;mask msb 0
	ld	(hl),a		;store active bit
	brnz	ifstat		;print status if IF still active
ifnderr:
	IF	NOISE
	call	print		;print message
	db	'N','o'+80h
	jp	prif
	ELSE		;NOT NOISE
	ret
	ENDIF		;NOISE

;
; FCP Command: ELSE
;   ELSE complements the Active Bit for the Current IF
;
;   Algorithm:
;	If Current IF is 0 (no IF) or 1 (one IF), then toggle
;		Active IF Bit associated with Current IF
;	Else
;		If Previous IF was Active then toggle
;			Active IF Bit associated with Current IF
;		Else do nothing
;
ifelse:
	IF	NOISE
	call	nl		;print new line
	ENDIF		;NOISE
	ld	hl,z3msg+1	;pt to IF msgs
	ld	a,(hl)		;get current IF
	ld	b,a		;save current IF in B
	inc	hl		;pt to active IF message
	rrca			;back up to previous IF level
	and	7fh		;mask out possible carry
	brz	iftog		;toggle if IF level is 0 or 1
	and	(hl)		;determine previous IF status
	brz	ifstat		;don't toggle, and just print status
iftog:
	ld	a,(hl)		;get active IF message
	cpl			;flip bits
	and	b		;look at only interested bit
	ld	c,a		;result in C
	ld	a,b		;complement IF byte
	cpl
	ld	b,a
	ld	a,(hl)		;get active byte
	and	b		;mask in only uninterested bits
	or	c		;mask in complement of interested bit
	ld	(hl),a		;save result and fall thru to print status
;
; Indicate if current IF is True or False
;
ifstat:
	IF	NOISE
	call	prif
	ld	b,'F'		;assume False
	call	iftest		;see if IF is FALSE (Z if so)
	brz	ifst1		;Zero means IF F or No IF
	ld	b,'T'		;set True
ifst1:
	ld	a,b		;get T/F flag and fall thru to print it
	ELSE		;NOT NOISE
	ret
	ENDIF		;NOISE

;
;  Console Output Routine
;
conout:
	push	hl		; save regs
	push	de
	push	bc
	push	af
	and	7fh		; mask 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 LF (to go with CR from ZCPR3)
;
nl:
	ld	a,lf		;output LF
	br	conout

;
; FCP Command: IF
;
ifstart:
	IF	NOISE
	call	nl		;print new line
	ENDIF		;NOISE

	call	iftest		;see if current IF is running and FALSE
	jp	z,ifcf

;
;****************************************************************
;*								*
;* Non-IF.COM Processing					*
;*								*
;****************************************************************

;
; Test for Equality if Enabled
;
	IF	IFOEQ
	ld	hl,tbuff+1	;look for '=' in line
tsteq:
	ld	a,(hl)		;get char
	inc	hl		;pt to next
	or	a		;EOL?
	brz	ifck0		;continue if so
	cp	'='		;'=' found?
	brnz	tsteq
	ld	hl,fcb1+1	;compare FCBs
	ld	de,fcb2+1
	ld	b,11		;11 bytes
eqtest:
	ld	a,(de)		;compare
	cp	(hl)
	brnz	ifcf
	inc	hl		;pt to next
	inc	de
	dbnz	eqtest
	br	ifct
	ENDIF		;IFOEQ
;
; Test Condition in FCB1 and file name in FCB2
;   Execute condition processing routine
;
ifck0:
	ld	de,fcb1+1	;pt to first char in FCB1
;
	IF	IFONEG
	ld	a,(de)		;get it
	ld	(negflag),a		;set negate flag
	cp	negchar		;is it a negate?
	brnz	ifck1
	inc	de		;pt to char after negchar
ifck1:
	ENDIF		;IFONEG
;
	IF	IFOREG		;REGISTERS
	call	regtest		;test for register value
	brnz	runreg
	ENDIF		;IFOREG
;
	call	condtest	;test of condition match
	brnz	runcond		;if found, process condition

	IF	COMIF
	jp	runcomif	;if function not found in table, use IF.COM
	ENDIF		;COMIF

	call	print		;beep to indicate error
	db	bell+80h
	jp	ifstat		;no condition, display current condition
;
; 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
	brz	ifctrue		;TRUE if match
	br	ifcfalse	;FALSE if non-match
	ENDIF		;IFOREG
;
; Process conditional test - address of conditional routine is in HL
;
runcond:
	jp	(hl)			;"call" routine pted to by HL
;
;
; Condition:  NULL (2nd file name)
;
	IF	IFONULL
ifcnull:
	ld	a,(fcb2+1)		;get first char of 2nd file name
	cp	' '		;space = null
	brz	ifctrue
	br	ifcfalse
	ENDIF		;IFONULL

;
; Condition:  TCAP
;
	IF	IFOTCAP
ifctcap:
	ld	a,(z3env+80h)	;get first char of Z3 TCAP Entry
	cp	' '+1		;space or less = none
	brc	ifcfalse
	br	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
	brz	ifcfalse	;FALSE if 0
	br	ifctrue
	ENDIF		;IFOWHEEL
;
; Condition:  TRUE
;	IFCTRUE  enables an active IF
; Condition:  FALSE
;	IFCFALSE enables an inactive IF
;
ifctrue:
;
	IF	IFONEG
	call	negtest	;test for negate
	brz	ifcf
	ENDIF		;IFONEG
;
ifct:
	ld	b,0ffh	;active
	jp	ifset
ifcfalse:
;
	IF	IFONEG
	call	negtest	;test for negate
	brz	ifct
	ENDIF		;IFONEG
;
ifcf:
	ld	b,0	;inactive
	jp	ifset

;
; 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?
	brz	ifctrue
	and	5fh		;mask and capitalize user input
	cp	'T'		;true?
	brz	ifctrue
	cp	'Y'		;yes?
	brz	ifctrue
	cp	cr		;yes?
	brz	ifctrue
	br	ifcfalse
	ENDIF		;IFOINPUT

;
; 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
	brz	ifcfalse	;return FALSE
	br	ifctrue		;return TRUE
	ENDIF		;IFOEXIST

;
; 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?
	brz	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
	brnz	ifctrue		;NZ if no read
	br	ifcfalse
	ENDIF		;IFOEMPTY

;
; Condition: ERROR
;
	IF	IFOERROR
ifcerror:
	ld	a,(z3msg+6)		;get error byte
	or	a		;0=FALSE (no error registered)
	brz	ifcfalse
	br	ifctrue
	ENDIF		;IFOERROR

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

;
; 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
	br	getn1	;continue processing
	ENDIF		;IFOREG

;
; Log into DU in FCB2
;
	IF	IFOEXIST OR IFOEMPTY

tlog:
	ld	a,(fcb2)	;get disk
	or	a	;current?
	brnz	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'
	brc	zret		;Z flag for no digit
	cp	10		;range?
	brnc	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:
	ld	hl,z3msg+1	;get IF flag
	ld	a,(hl)		;test for active IF
	or	a
	brz	ifok		;no active IF
	inc	hl		;pt to active flag
	and	(hl)		;check active flag
	ret	z			;return Z since IF running and FALSE
ifok:
	xor	a		;return NZ for OK
	dec	a
	ret

;
; Test FCB1 against condition table (must have 2-char entries)
;  Return with routine address in HL if match and NZ flag
;
;	IF	NOT COMIF
condtest:
	ld	hl,condtab	;pt to table
condt1:
	ld	a,(hl)		;end of table?
	or	a
	ret	z
	ld	a,(de)		;get char
	ld	b,(hl)		;get other char in B
	inc	hl		;pt to next
	inc	de
	cp	b		;compare entries
	brnz	condt2
	ld	a,(de)		;get 2nd char
	cp	(hl)		;compare
	brnz	condt2
	inc	hl		;pt to address
	ld	a,(hl)		;get address in HL
	inc	hl
	ld	h,(hl)
	ld	l,a		;HL = address
	xor	a		;set NZ for OK
	dec	a
	ret
condt2:
	ld	bc,3		;pt to next entry
	add	hl,bc		; ... 1 byte for text + 2 bytes for address
	dec	de		;pt to 1st char of condition
	br	condt1
;
;	ENDIF		;NOT COMIF
;
; Turn on next IF level
;   B register is 0 if level is inactive, 0FFH is level is active
;   Return with Z flag set if OK
;
ifset:
	ld	hl,z3msg+1	;get IF flag
	ld	a,(hl)
	or	a		;if no if at all, start 1st one
	brz	ifset1
	cp	80h		;check for overflow (8 IFs max)
	brz	iferr
	inc	hl		;pt to active IF byte
	and	(hl)		;check to see if current IF is TRUE
	brnz	ifset0		;if TRUE, proceed
	ld	b,0		;set False IF
ifset0:
	dec	hl		;pt to IF level
	ld	a,(hl)		;get it
	rlca			;advance to next level
	and	0feh		;only 1 bit on
	ld	(hl),a		;set IF byte
	br	ifset2
ifset1:
	inc	a		;A=1
	ld	(hl),a		;set 1st IF
	inc	hl		;clear active IF byte
	ld	(hl),0
	dec	hl
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
	ld	d,a
	ld	a,(hl)		;get active byte
	and	d		;mask in only uninterested bits
	or	b		;mask in complement of interested bit
	ld	(hl),a		;save result
	call	ifstat		;print status
	xor	a		;return with Z
	ret
iferr:
	call	print		;beep to indicate overflow
	db	bell+80h
	xor	a		;set NZ
	dec	a
	ret

;****************************************************************
;*								*
;* IF.COM Processing						*
;*								*
;****************************************************************

;
; If IF.COM to be processed, goto ROOT (base of path) and load it
;
	IF	COMIF

runcomif:

	IF	PATHROOT
;
; Get Current Disk and User in BC
;
	ld	a,(udflag)		;get UD
	push	af		;save UD flag
	and	0fh		;get disk
	ld	(cdisk),a		;set current disk
	ld	b,a		;B=disk (A=0)
	pop	af		;get UD flag
	rlca			;get user in low 4 bits
	rlca
	rlca
	rlca
	and	0fh		;get user
	ld	(cuser),a		;set current user
	ld	c,a		;... in C
;
; Pt to Start of Path
;
	ld	hl,expath	;pt to path
;
; Check for End of Path
;
fndroot:
	ld	a,(hl)		;check for done
	or	a		;end of path?
	brz	froot2
;
; Process Next Path Element
;
	cp	'$'		;current disk?
	brnz	froot0
	ld	a,(cdisk)		;get current disk
	inc	a		;+1 for following -1
froot0:
	dec	a		;set A=0
	ld	b,a		;set disk
	inc	hl		;pt to user
	ld	a,(hl)		;get user
	cp	'$'		;current user?
	brnz	froot1
	ld	a,(cuser)		;get current user
froot1:
	ld	c,a		;set user
	inc	hl		;pt to next
	br	fndroot
;
; Done with Search - BC Contains ROOT DU
;
	ENDIF		;PATHROOT

	IF	NOT PATHROOT

;
; Save default drive and user values
;
	ld	a,(udflag)		;get UD
	push	af		;save UD flag
	and	0fh		;get disk
	ld	(cdisk),a		;set current disk
	pop	af		;get UD flag
	rlca			;get user in low 4 bits
	rlca
	rlca
	rlca
	and	0fh		;get user
	ld	(cuser),a		;set current user
;
; Set BC to drive/user in which to find IF.COM
;
	ld	bc,100h*[ifdrv-'A'] + ifusr

	ENDIF		;NOT PATHROOT	

froot2:
;
; Log Into ROOT
;
	call	logbc		;log into root DU
;
; Set Address of Next Load and Set DMA for OPEN
;
	ld	hl,100h		;pt to TPA
	ld	(nxtload),hl		;set address for next load
	ex	de,hl			;DE=100H so don't wipe out buffers
	ld	c,26		;set DMA
	call	bdos
;
; Try to Open File IF.COM
;
	ld	de,extfcb	;pt to FCB
	ld	c,15		;open file
	call	bdos
	inc	a		;check for found
	jp	z,ifnotfnd
;
; Load File IF.COM
;
ifload:
;
; Set Load Address
;
	ld	hl,(nxtload)		;get address of next load
	push	hl		;save it
	ld	de,80h		;pt to following
	add	hl,de
	ld	(nxtload),hl
	pop	de		;get load address
	ld	c,26		;set DMA
	call	bdos
;
; Read in Block (Sector) and Loop Back if Not Done
;
	ld	de,extfcb	;read file
	ld	c,20
	push	de		;save ptr in case of failure (done)
	call	bdos
	pop	de
	or	a		;OK?
	brz	ifload
;
; Done - Close File
;
	ld	c,16		;close file
	call	bdos
;
; Reset Environment (DMA and DU) and Run IF.COM
;
	call	reset		;reset DMA and directory
	jp	tpa		;run IF.COM
;
; Reset DMA Address and Current Disk (in CDISK) and User (in CUSER)
;
reset:
	ld	de,80h		;reset DMA address
	ld	c,26
	call	bdos
	ld	a,(cdisk)		;return home
	ld	b,a
	ld	a,(cuser)
	ld	c,a
;
; 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
;
; IF.COM not found - Process as IF F
;
ifnotfnd:
	call	reset		;return home
	jp	ifcf
;
; Buffers for COMIF
;
nxtload:
	ds	2		;address of next block (sector) to load
cuser:
	ds	1		;current user
cdisk:
	ds	1		;current disk (A=0)
;
	ENDIF		;COMIF
;

;
; Test for Size Error
;
	if	[$ gt [fcp + fcps*128]]
sizerr	equ	novalue	;FCP is too large for buffer
	endif

	end