ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/BEEHIVE/ZSUS/ZSUS009.LBR/NZFCP13.LBR/NZFCP13.ZZ0/NZFCP13.Z80

Text File | 1990-07-14 | 34KB | 1,424 lines

; 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