mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1424 lines
33 KiB
1424 lines
33 KiB
|
|
; 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
|
|
|