ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/ZCPR33/A-R/COMIF10.LBR/COMIF10.ZZ0/COMIF10.Z80

Text File | 2000-06-30 | 43KB | 1,611 lines

; Program: COMIF
; Author: Jay Sage
; Version: 1.0
; Date: March 10, 1987
; Previous Versions:  Derived from IF (originated by Richard Conn)


;            * * *   IMPORTANT NOTE   * * *
;
; This program is copyrighted 1987 by Jay Sage.  It may be copied and modified
; freely for personal use but may not be sold or distributed for a fee.  It is
; being released through the NAOG/ZSIG organization, and modified versions must
; be submitted to and approved by NAOG/ZSIG before they may be distributed.
; See the file ZSIGPOL1.DOC on Z-Nodes for the ZSIG policy on signing out and
; modifying programs.


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

VERSION EQU    10

; 03/10/87    Creation of COMIF program from IF.
;   1.0
;        Hex/binary/octal numerical inputs implemented for all number
;        entry.
;
;        "IF INPUT" prompt text has controls to generate control
;        character output and upper/lower case text.  A '^' converts
;        the following character to a control character.  The sequence
;        '%<' toggles output to upper case; '%>' toggles to lower case.
;
;        Added following tests:
;            IF AMBIG    tests for file ambiguity
;            IF ARCHIVE    tests for file archive attribute
;            IF BG        tests for presence of BackGrounder
;            IF COMPR    tests for squeezed or crunched file
;            IF DS        tests for presence of DateStamper
;            IF LIST        tests for items separated by commas
;            IF RO        test for file R/O attribute
;            IF SHELL    tests for shell on stack
;            IF SYS        tests for file SYS attribute
;            IF TAG        tests for tag attribute (tag specified
;                    following file names, i.e
;                    IF TAG FILE.EXT 3)
;            IF ZEX        tests for ZEX running
;
;        Added more general equality/inequality testing options for
;        strings.  If XCOMP1 is true, the following conditions are
;        recognized: EQ, NE, GT, GE, LT, LE.  All can be negated with ~.
;        If XCOMP2 is true, the following conditions are also allowed:
;        =   <>   ><   >   >=   <   <=.  All can be negated with '~'.
;
;        Added extended register and value testing options (if REGVALOPT
;        is true).  Syntax forms are:
;
;            IF [~]REG REG# OPERATOR VALUE
;            IF [~]VALUE ARG1 OPERATOR ARG2
;
;        VALUE compares two 16-bit numerical arguments; REG treats the
;        first argument as a register number rather than a value.
;        Spaces are optional surrounding the operator, and the following
;        operators are recognized:  =   <>   ><   >   >=   <   <=.
;        Here are some examples:
;
;            IF REG 3 > 1CH        IF REG 9= 0
;            IF REG 3 <>1101B    IF ~REG 011B=15Q
;            IF VAL C000H > 40000
;
;        Added many optional extensions to conditions.  IF TCAP can now
;        test for a specific TCAP using the syntax IF TCAP STRING.  The
;        string may have '?' wild cards in it.  The TCAP ID string is
;        compared to the given string up to the length of the latter.
;
;        Specific error conditions can be tested using the optional
;        syntax IF ERROR VALUE.
;
;        One can test for a particular shell program on the top of the
;        stack using IF SHELL NAME, where NAME may be ambiguous.
;
;        Modified EXIST and EMPTY tests to share code and meaning.  The
;        two tests are now the same except that (1) the EX test only
;        checks for the presence of a directory entry while EM also
;        checks for contents and (2) the senses of the tests are
;        reversed (EX is true if all files in list exist; EM is false
;        if all files exist and have contents.  Thus ~EM is equivalent
;        to EX but with a more stringent existence requirement).  Note
;        that when the file list has ambiguous filespecs, only the
;        first matching file is checked.
;
;        I would like to acknowlege extensive contributions to the
;        coding of COMIF by Howard Goldstein.
;
;                Jay Sage


; HISTORY OF IF.COM VERSIONS FROM WHICH THIS PROGRAM WAS DERIVED

; 12/09/85    Fixed shortcoming in IF NULL test.  We now do it by checking
;   1.4        the command tail for characters.  IF NULL will now return false
;        if the second token is any kind of drive/user or named
;        directory specification as well as a file name.
;                Jay Sage

; 09/06/85    Fixed mistake in IF ERROR code.  It was testing the error
;   1.3        handler flag instead of the program error flag.  Also enhanced
;        IF INPUT.  If text follows the INPUT token, then this text is
;        echoed to the console followed by ' (Y/N)? '.  If there is no
;        text, IF IN works as before.
;                Jay Sage

; IF is intended to be invoked from the IF routine in an FCP.  This program
; implements the IF conditional tests and sets the next level of IF to be TRUE
; or FALSE.
;
; Modified on 02/11/85 to accept ambiguous file names and match them. This
; allows aliases to add file extensions if they are needed, for instance
; if there is an alias LDIR that gets a directory of an .LBR file, it
; previously had to be defined as an example :



; Configuration Equates

NO        EQU    0
YES        EQU    NOT NO

USEDSEG        EQU    YES    ; Yes to put uninitialized data in a data
                ; segment (special linking required)

UPCASE        EQU    YES    ; Default to upper case output with IF IN
                ; ..prompt string
UCASECH        EQU    '<'    ; Character to toggle to upper case output
LCASECH        EQU    '>'    ; Character to toggle to lower case output

COMPROPT    EQU    YES    ; Include compressed file test

LISTOPT        EQU    YES    ; Include IF LIST test

TAGOPT        EQU    YES    ; Include IF TAG test
ARCOPT        EQU    YES    ; Include IF ARCHIVE test
ROOPT        EQU    YES    ; Include IF RO test
SYSOPT        EQU    YES    ; Include IF SYS test
ATTROPTS    EQU    TAGOPT OR ARCOPT OR SYSOPT OR ROOPT

SHELLOPT    EQU    YES    ; Include IF SHELL test
ZEXOPT        EQU    YES    ; Include IF ZEX test
REGVALOPT    EQU    YES    ; Include IF REG and IF VAL tests

PLUPERFOPT    EQU    YES    ; Include IF BG and IF DS tests
IDOFF        EQU    5BH    ; Offset to BG ID in CCP

XERROPT        EQU    YES    ; Include extended ERROR option (IF ER VALUE)
XTCAPOPT    EQU    YES    ; Include extended TCAP option (IF TC STRING)
XSHELLOPT    EQU    YES    ; Include extended SHELL option (IF SHELL NAME)
XCOMP1        EQU    YES    ; Include extended comparision tests EQ, NE,
                ; ..GT, GE, LT, LE
XCOMP2        EQU    YES    ; Include extended comparision tests '=', '<>'
                ; '><', '>', '>=', '<', '<="
XCOMP        EQU    XCOMP1 OR XCOMP2

NEGCHAR     EQU    '~'    ; Negation prefix char

Z3ENV        EQU    0FE00H    ; Address of ZCPR3 environment


; Miscellaneous Equates

BDOS    EQU    5
FCB1    EQU    5CH
FCB2    EQU    6CH
TBUFF    EQU    80H
CR    EQU    0DH
LF    EQU    0AH
TAB    EQU    09H
BEL    EQU    07H


; External Z3LIB and SYSLIB Routines

    EXT    Z3INIT,STRTZEX,STOPZEX,GETZRUN,GETER2,GETREG
    EXT    IFT,IFF,GETENV,GETWHL,GETSH1,ZFNAME

    EXT    EVAL,PSTR,PRINT,CAPINE,CODEND,SKSP,SKNSP,COUT,CAPS
    EXT    COMPHD


; External ZCPR3 Environment Descriptor

    JP    START

    DEFB    'Z3ENV'        ; This is a ZCPR3 Utility
    DEFB    1        ; External Environment Descriptor
Z3EADR:
    DEFW    Z3ENV


CONDTAB:

    DEFB    'T '        ; Set state to TRUE
    DEFW    IFCTRUE

    DEFB    'F '        ; Set state to FALSE
    DEFW    IFCFALSE

    DEFB    'AM'        ; Test for ambiguous file specification
    DEFW    IFCAMBIG

     IF    ARCOPT
    DEFB    'AR'        ; Test for archive attribute
    DEFW    IFCARC
     ENDIF    ; ARCOPT

     IF    PLUPERFOPT
    DEFB    'BG'        ; Test for BackGrounder loaded
    DEFW    IFCBG
     ENDIF    ; PLUPERFOPT

     IF    COMPROPT
    DEFB    'CO'        ; Test for squeezed or crunched file
    DEFW    IFCCOMPR
     ENDIF    ; COMPROPT

     IF    PLUPERFOPT
    DEFB    'DS'        ; Test for DateStamper loaded
    DEFW    IFCDS
     ENDIF    ; PLUPERFOPT

    DEFB    'EM'        ; Test for empty file(s)
    DEFW    IFCEMPTY

    DEFB    'ER'        ; Test state of program error flag
    DEFW    IFCERROR

    DEFB    'EX'        ; Test for existence of file(s)
    DEFW    IFCEXIST

    DEFB    'IN'        ; Get user input
    DEFW    IFCINPUT

     IF    LISTOPT
    DEFB    'LI'        ; Test for multiple item token
    DEFW    LIST
     ENDIF    ; LISTOPT

    DEFB    'NU'        ; Test for null argument
    DEFW    IFCNULL

     IF    REGVALOPT
    DEFB    'RE'        ; Test register values
    DEFW    IFCREG
     ENDIF    ; REGVALOPT

     IF    ROOPT
    DEFB    'RO'        ; Test for read-only attribute
    DEFW    IFCRO
     ENDIF    ; ROOPT

     IF    SHELLOPT
    DEFB    'SH'        ; Test for shell name on shell stack
    DEFW    IFCSHELL
     ENDIF    ; SHELLOPT

     IF    SYSOPT
    DEFB    'SY'        ; Test for sys file attribute
    DEFW    IFCSYS
     ENDIF    ; SYSOPT

     IF    TAGOPT
    DEFB    'TA'        ; Test for tag attributes
    DEFW    IFCTAG
     ENDIF    ; TAGOPT

    DEFB    'TC'        ; Test for Z3TCAP entry loaded
    DEFW    IFCTCAP

     IF    REGVALOPT
    DEFB    'VA'        ; Compare numerical values
    DEFW    IFCVAL
     ENDIF    ; REGVALOPT

    DEFB    'WH'        ; Test if wheel byte set
    DEFW    IFCWHEEL

     IF    ZEXOPT
    DEFB    'ZE'        ; Test if ZEX running
    DEFW    IFCZEX
     ENDIF    ; ZEXOPT

     IF    XCOMP1
    DEFB    'EQ'        ; Test for equality
    DEFW    IFCEQUAL
    DEFB    'NE'        ; Test for nonequality
    DEFW    IFCNOTEQUAL
    DEFB    'GE'        ; Test for ARG1 greater than or equal to ARG2
    DEFW    IFCGTOREQ
    DEFB    'GT'        ; Test for ARG1 greater than ARG2
    DEFW    IFCGREATER
    DEFB    'LT'        ; Test for ARG1 less than ARG2
    DEFW    IFCLESS
    DEFB    'LE'        ; Test for ARG1 less than or equal to ARG2
    DEFW    IFCLTOREQ
     ENDIF    ; XCOMP1

     IF    XCOMP2
    DEFB    '= '        ; Test for equality
    DEFW    IFCEQUAL
    DEFB    '<>'        ; Test for nonequality
    DEFW    IFCNOTEQUAL
    DEFB    '><'        ; Test for nonequality
    DEFW    IFCNOTEQUAL
    DEFB    '>='        ; Test for ARG1 greater than or equal to ARG2
    DEFW    IFCGTOREQ
    DEFB    '> '        ; Test for ARG1 greater than ARG2
    DEFW    IFCGREATER
    DEFB    '< '        ; Test for ARG1 less than ARG2
    DEFW    IFCLESS
    DEFB    '<='        ; Test for ARG1 less than or equal to ARG2
    DEFW    IFCLTOREQ
     ENDIF    ; XCOMP2

    DEFB    0


; Start of program -- initialization

START:
    LD    (STACK),SP    ; Save system stack pointer
    LD    SP,STACK    ; Set up local stack
    LD    HL,(Z3EADR)    ; Pt to ZCPR3 environment
    CALL    Z3INIT        ; Initialize the ZCPR3 Environment
    XOR    A        ; Clear negation flag
    LD    (NEGFLAG),A

; Test for ARG1=ARG2 syntax (as single token with no spaces)

    LD    HL,TBUFF+1    ; Point to command tail
    CALL    SKSP        ; Start at first token
    LD    D,H        ; Copy HL into DE for use at IFCK0
    LD    E,L
    LD    A,(HL)        ; Check for no tail
    OR    A
    JR    Z,IFHELP    ; Show help screen if no tail

     IF    XCOMP2        ; If conditions such as '<=' are allowed
    CP    '<'        ; ..check for them and go to IFCK0 if found
    JR    Z,IFCK0
    CP    '>'
    JR    Z,IFCK0
    CP    NEGCHAR
    JR    Z,IFCK0
     ENDIF    ; XCOMP2

IFTEQ:                ; Scan for '=' starting with second character
    INC    HL        ; Point to next character
    LD    A,(HL)        ; Get it
    CP    ' '+1        ; Test for end of token
    JR    C,IFCK0        ; If end, we do not have ARG1=ARG2 syntax
    CP    '='        ; Have we found '='?
    JR    NZ,IFTEQ    ; If not, keep looping
    LD    HL,FCB1+1    ; If so, compare FCB1 to FCB2
    JP    IFCEQ

; Test for help request or negation character

IFCK0:
    LD    A,(DE)        ; Get first char of first token in tail
    CP    '/'        ; If explicit help request
    JR    Z,IFHELP    ; ..jump to help display
    CP    NEGCHAR        ; If not negation character
    JR    NZ,IFCK1    ; ..then leave negflag as is
    CALL    NEGCOMPL    ; Else complement the flag setting
    INC    DE        ; ..and point to char after negchar

; Test for register syntax of form "IF REG# VALUE"

IFCK1:
    PUSH    DE        ; Save pointer
    CALL    REGTEST        ; Will not return if "IF REG# VALUE" syntax
    POP    DE

; Scan for condition option

    CALL    CONDTEST    ; Test of condition match
    JR    Z,CONDERROR    ; Error message if condition not recognized
    JP    (HL)        ; Process condition testing

; Fall-through error code

CONDERROR:
    CALL    PRINT
    DEFB    ' Bad IF Condition',0
    JP    ERRORMSG

; Print help message

IFHELP:
    CALL    PRINT
    DEFB    CR,LF,LF
    DEFB    TAB,TAB,'COMIF '
    DEFB    (VERSION/10)+'0','.',(VERSION MOD 10)+'0'
    DEFB    ' [ZSIG]'

    DEFB    CR,LF,LF,'SYNTAX:',TAB,'(1) IF ARG1=ARG2'
    DEFB    CR,LF,TAB,'(2) IF REGISTER# [VALUE]'
    DEFB    CR,LF,TAB,'(3) IF CONDITION ARGUMENTS'

    DEFB    CR,LF,LF,'CONDITIONS:'
    DEFB    CR,LF,TAB,'T, F, AMBIG'

     IF    ARCOPT
    DEFB    ', ARCHIVE'
     ENDIF    ; ARCOPT

     IF    PLUPERFOPT
    DEFB    ', BG'
     ENDIF    ; PLUPERFOPT

     IF    COMPROPT
    DEFB    ', COMPR'
     ENDIF    ; COMPROPT

     IF    PLUPERFOPT
    DEFB    ', DS'
     ENDIF    ; PLUPERFOPT

    DEFB    ', EMPTY'
    DEFB    ', ERROR'
    DEFB    ', EXIST'
    DEFB    ', INPUT'

    DEFB    CR,LF,TAB,'NULL'

     IF    LISTOPT
    DEFB    ', LIST'
     ENDIF    ; LISTOPT

     IF    REGVALOPT
    DEFB    ', REG'
     ENDIF    ; REGVALOPT

     IF    ROOPT
    DEFB    ', RO'
     ENDIF    ; ROOPT

     IF    SHELLOPT
    DEFB    ', SHELL'
     ENDIF    ; SHELLOPT

     IF    SYSOPT
    DEFB    ', SYS'
     ENDIF    ; SYSOPT

     IF    TAGOPT
    DEFB    ', TAG'
     ENDIF    ; TAGOPT

    DEFB    ', TCAP'

     IF    REGVALOPT
    DEFB    ', VALUE'
     ENDIF    ; REGVALOPT

    DEFB    ', WHEEL'

     IF    ZEXOPT
    DEFB    ', ZEX'
     ENDIF    ; ZEXOPT

     IF    XCOMP
    DEFB    CR,LF,TAB
     ENDIF    ; XCOMP

     IF    XCOMP1
    DEFB    'EQ NE GT GE LT LE  '
     ENDIF    ; XCOMP1

     IF    XCOMP2
    DEFB    '=  <>  ><  >  >=  <  <='
     ENDIF    ; XCOMP2

    DEFB    CR,LF,LF,'Only first 2 letters of condition are significant.'
    DEFB    CR,LF,'A leading ''',NEGCHAR,''' negates all forms except (1).'
    DEFB    CR,LF,'See COMIF.HLP for details.'
    DEFB    CR,LF
    DEFB    0

    JP    RETURN


;=============================================================================
;
;        C O N D I T I O N    T E S T I N G
;
;=============================================================================

; Condition:  NULL
;
;    If any text other than spaces appears on the command line after
;    the 'NULL' option, then the IF state is set to false.  This differs
;    from the IF NULL test in the SYSFCP code, which returns false
;    only when a file name is given as a second token but not when a
;    directory specification is given.

IFCNULL:
    LD    HL,TBUFF+1    ; Point to command tail
    CALL    SKIP2        ; Skip to second token
    JR    Z,TRUEREL
FALSEREL:            ; Entry point for relative jump
    JP    IFCFALSE


;=============================================================================
;
;    P L U P E R F E C T    E X T E N S I O N    T E S T I N G
;
;=============================================================================

     IF    PLUPERFOPT

; Condition:  BG (BackGrounder)
;
;    This option tests for the presence of the 'BGii' ID string that
;    shows that BackGrounder ii is running.  The code looks for the
;    ID at an offset of IDOFF from the beginning of the CPR code.  The
;    value if IDOFF was determined by examination.

IFCBG:
    LD    HL,(0001)        ; Get BIOS pointer
    LD    DE,-1603H+IDOFF        ; Offset to 'BGii' ID string in BG CPR
    ADD    HL,DE
    LD    DE,IDSTR        ; Point to reference ID string
    LD    B,IDLEN            ; Length of ID string
BGCHK1:
    LD    A,(DE)            ; Get reference character
    CP    (HL)            ; Compare to actual character
    JR    NZ,FALSEREL        ; Set false if mismatch
    INC    HL            ; Move to next characters
    INC    DE
    DJNZ    BGCHK1            ; Loop through all characters
BGTRUE:                    ; Entry point for relative jump
    JR    TRUEREL            ; They match, so set true

IDSTR:    DEFB    'BGii'
IDLEN    EQU    $ - IDSTR

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

; Condition: DS (DateStamper)
;
;    This option tests for the presence of DateStamper.

IFCDS:
    LD    E,'D'            ; DateStamper ID character
    LD    C,0CH            ; Return version function
    CALL    BDOS
    CP    22H            ; Must be CP/M 2.2
    JR    NZ,FALSEREL        ; If not, set false IF state
    LD    A,H            ; Check for return of ID
    CP    'D'
    JR    NZ,FALSEREL        ; If not, set false IF state
    JR    BGTRUE            ; Otherwise set true IF state

     ENDIF    ; PLUPERFOPT


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

     IF    XCOMP        ; If extended compare options included


; Condition: NE (Not Equal)
;
;    This test is equivalent to ~EQ.

IFCNOTEQUAL:
    CALL    NEGCOMPL    ; Complement the negation flag
    JR    IFCEQUAL    ; Then perform EQ test

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

; Condition:  EQ (Equal)
;
;    This test compares the next two tokens for equality, with wildcards
;    ('?') always being taken as equality.  This code is used (at IFCEQ)
;    by the direct syntax version "IF ARG1=ARG2" and by the consistent
;    forms "IF EQ ARG1 ARG2" or "IF ~EQ ARG1 ARG2" or "IF = ARG1 ARG2"
;    and so on.

IFCEQUAL:
    CALL    SETCOMPARE    ; Set up for comparison (ARG1 in FCB1,
                ; ..ARG2 in FCB2)

     ENDIF    ; XCOMP

; Entry point for "IF ARG1=ARG2" syntax (THIS CODE IS USED EVEN IF XCOMP IS
; FALSE)

IFCEQ:
    CALL    COMPARE        ; Perform comparison
    JR    NZ,FALSEREL    ; False if not equal
TRUEREL:            ; Entry point for relative jump
    JP    IFCTRUE        ; Otherwise true

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

; Condition: LE (Less Than or Equal)
;
;    This test returns true if ARG1 is the same as or less than ARG2 in
;    the expression "IF LE ARG1 ARG2".  Wild cards are taken as equality.

     IF    XCOMP

IFCLTOREQ:
    CALL    NEGCOMPL    ; Complement the negation flag
    JR    IFCGREATER    ; Then use GT test

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

; Condition:  GT (Greater Than)
;
;    This test returns true if ARG1 is greater than ARG2 in the expression
;    "IF GT ARG1 ARG2".  Wild card characters are taken as equality.

IFCGREATER:
    CALL    SETCOMPARE    ; Set up for comparison
    CALL    COMPARE        ; Perform comparison
    JR    Z,FALSEREL    ; False if equal
    JR    C,FALSEREL    ; False if ARG2 (in FCB1) greater than ARG2
    JR    TRUEREL        ; Otherwise true

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

; Condition:  LT (Less Than)
;
;    This test returns true if ARG1 is less than ARG2 in the expression
;    "IF LT ARG1 ARG2".  Wild card characters are taken as equality.

IFCLESS:
    CALL    NEGCOMPL    ; Complement negation flag
    JR    IFCGTOREQ    ; Then use GE test

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

; Condition:  GE (Greater Than or Equal)
;
;    This test returns true if ARG1 is greater than or equal to ARG2 in the
;    expression "IF GE ARG1 ARG2".  Wild card characters are taken as
;    equality.

IFCGTOREQ:
    CALL    SETCOMPARE    ; Set up for comparison
    CALL    COMPARE        ; Perform comparison
    JR    Z,TRUEREL    ; True if equal
    JR    C,FALSEREL    ; False if ARG2 (in FCB1) greater than ARG2
    JR    TRUEREL        ; Otherwise true

     ENDIF    ; XCOMP

;=============================================================================
;
;    R E G I S T E R    A N D    V A L U E    T E S T I N G
;
;=============================================================================

; Condition:  REG
;
;    This test uses the syntax "IF [~]REG REG# OPERATOR VALUE" to test
;    values stored in user registers R#=0..9.  The allowed operators
;    are:    =    <>    ><
;        >    >=    <    <=
;    Spaces around the operators are optional.  Values may be entered in
;    decimal, octal, binary, or hexadecimal format.

     IF    REGVALOPT

IFCREG:
    CALL    SKIP2        ; Skip to REG# token
    CALL    GETNUM        ; Convert to a number
    LD    A,9        ; Test for value not larger than 9
    CP    B
    JR    NC,IFCREG1    ; Jump if value is OK

    CALL    PRINT
    DEFB    ' Bad register number',0
    JP    ERRORMSG    ; Return with false if state

IFCREG1:
    CALL    GETREG        ; Get value of designated register
    LD    B,A        ; Save it in B
    CALL    SKSP        ; Skip to operator (if there are spaces)
    CALL    READOPER    ; Read the operator (save in register C)
    CALL    SKSP        ; Skip over spaces if any to value
    PUSH    BC        ; Save register value and operator
    CALL    GETNUM        ; Get value for comparison into B
    POP    DE        ; Restore register value to D, operator to E
    LD    A,D        ; Form (REGISTERVALUE - REFERENCEVALUE)
    SUB    B
IFCREG1A:
    PUSH    AF        ; Save result
    LD    A,E        ; Branch based on operator type
    CP    '='
    JR    Z,IFCREG2
    CP    '>'
    JR    Z,IFCREG3
                ; Less-than case
    POP    AF
    JR    C,REGTRUE
REGFALSE:            ; Entry point for relative jump
    JP    IFCFALSE

IFCREG2:            ; Equal case
    POP    AF
    JR    Z,REGTRUE
    JR    REGFALSE

IFCREG3:            ; Greater-than case
    POP    AF
    JR    Z,REGFALSE
    JR    C,REGFALSE
REGTRUE:            ; Entry point for relative jump
    JP    IFCTRUE

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

;  Condition:  VAL
;
;    This option compares two 16-bit numerical values using the syntax
;    IF VAL ARG1 ARG2.

IFCVAL:
    CALL    SKIP2        ; Point to ARG1
    CALL    EVAL        ; Get 16-bit value into DE
    JP    C,NUMERROR    ; Error if carry flag set

    PUSH    DE        ; Save ARG1 value on stack
    CALL    SKSP        ; Skip to operator (if there are spaces)
    CALL    READOPER    ; Read the operator (save in register C)
    CALL    SKSP        ; Skip over spaces if any to value
    CALL    EVAL        ; Get its value into DE
    POP    HL        ; Get ARG1 value back in HL
    JP    C,NUMERROR    ; Error if carry flag set

    CALL    COMPHD        ; Compare DE-HL
    LD    E,C        ; Put operator character in E
    JR    IFCREG1A    ; Use REG testing code to complete

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

; Subroutine to interpret a comparison operator string
;
;    This subroutine reads an operator string of one or two characters.
;    When called, HL points to the character string; on exit, HL points
;    to the character following the operator string, register C contains
;    an effective one-character operator (= or < or >), and the negation
;    flag has been complemented if the operators were not-equal, greater-
;    than-or-equal, or less-than-or-equal.  If an invalid operator string
;    is encountered, the routine displays an error message and returns
;    a false if state.

READOPER:
    LD    A,(HL)        ; Get first operator character
    LD    C,A        ; Save it in C
    INC    HL        ; Point to next character
    CP    '='        ; Equality?
    RET    Z        ; If so, we have complete operator
    CP    '>'        ; Greater than?
    JR    Z,GTOPER    ; If so, jump
    CP    '<'        ; Less than?
    JR    Z,LTOPER    ; If so, jump

    CALL    PRINT        ; We must have a bad operator
    DEFB    ' Bad operator',0
    JP    ERRORMSG    ; Return with false if state

GEOPER:                ; Treat '>=' as 'not <'
    LD    A,'<'        ; Equivalent negated operator
    JR    SETOPER

GTOPER:
    LD    A,(HL)        ; Check for second operator character
    CP    '='        ; Greater than or equal?
    JR    Z,GEOPER
    CP    '<'        ; Not equal "><" ?
    RET    NZ        ; If not, must be end of operator string
                ; If so, fall through to NEOPER
NEOPER:
    LD    A,'='        ; Equivalent negated operator
SETOPER:
    LD    C,A        ; Save operator in C
    INC    HL        ; Point to character after operator string
    JP    NEGCOMPL    ; Complement negation flag and return

LTOPER:
    LD    A,(HL)        ; Check for second operator character
    CP    '='        ; Less than or equal?
    JR    Z,LEOPER
    CP    '>'        ; Not equal?
    JR    Z,NEOPER
    RET            ; We have '<'

LEOPER:
    LD    A,'>'        ; Equivalent negated operator
    JR    SETOPER

     ENDIF    ; REGVALOPT

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

; Condition:  TCAP
;
;    This test returns true if any terminal capability descriptor is
;    loaded into the TCAP buffer.  If the XTCAPOPT equate is true, then
;    the following extended syntax is supported:
;
;            IF TCAP STRING
;
;    The name of the loaded terminal will be compared to the string, and
;    the if state will be set to true only if they match.  The comparison
;    is made only for the number of characters present in STRING, and
;    wild cards ('?') are allowed in STRING.

IFCTCAP:
    CALL    GETENV        ; Get ptr to ZCPR3 environment descriptor
    LD    DE,80H        ; Pt to TCAP entry
    ADD    HL,DE
    LD    A,(HL)        ; Get first char
    CP    ' '+1        ; Space or less = none
    JR    C,AMBFALSE

     IF    XTCAPOPT    ; Extended TCAP condition testing

    PUSH    HL        ; Save pointer to TCAP ID
    CALL    SKIP2        ; Make HL point to second command-line token
    POP    DE        ; Get TCAP ID pointer into DE
IFCTCAP1:
    LD    A,(HL)        ; Get character from test string
    OR    A        ; Test for end of line
    JR    Z,WHLTRUE    ; If end of string, ID matches
    CP    '?'        ; If wild card, take it as a match
    JR    Z,IFCTCAP2
    LD    A,(DE)        ; Get character from TCAP ID
    CALL    CAPS        ; Capitalize it
    CP    (HL)        ; Compare to test string
    JR    NZ,AMBFALSE    ; Mismatch found
IFCTCAP2:
    INC    HL        ; Advance pointers
    INC    DE
    JR    IFCTCAP1    ; Loop through string

     ELSE    ; NOT XTCAPOPT

    JR    WHLTRUE

     ENDIF    ; XTCAPOPT


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

; Condition:  WHEEL
;
;    This test returns true if the wheel byte contains a value other
;    than zero.

IFCWHEEL:
    CALL    GETWHL        ; Get current wheel setting
    JR    Z,AMBFALSE
WHLTRUE:            ; Entry point for relative jump
    JP    IFCTRUE


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

; Condition:  AMBIG
;
;    This test returns true if the file specification given as the second
;    token on the command line is ambiguous (contains '*' or '?').

IFCAMBIG:
    LD    HL,FCB2+1    ; Scan FCP2 for '?' characters
    LD    B,11        ; Characters to scan
    LD    A,'?'        ; Target character
AMBIG1:
    CP    (HL)        ; Is character in file name is '?'
    JR    Z,WHLTRUE    ; If so, test is true
    INC    HL        ; Point to next character
    DJNZ    AMBIG1        ; Loop back to test more
AMBFALSE:            ; Entry point for relative jumps
    JP    IFCFALSE    ; Must not be ambiguous


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

; Condition:  COMPRESSED

     IF    COMPROPT

IFCCOMPR:
    LD    A,(FCB2+10)    ; Get middle character of file type
    CP    'Z'        ; Crunched
    JR    Z,WHLTRUE
    CP    'Q'        ; Squeezed
    JR    Z,WHLTRUE
    JR    AMBFALSE

     ENDIF    ; COMPROPT

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

;  Condition:  LIST

;    this test returns true if the following token contains multiple
;    items separated by commas.

     IF    LISTOPT

LIST:
    CALL    SKIP2        ; Skip to 2nd token

LIST1:
    LD    A,(HL)        ; Get character
    INC    HL        ; Point to next character
    CP    ' '+1        ; End of token?
    JR    C,AMBFALSE    ; Set false if so
    CP    ','        ; A comma?
    JR    NZ,LIST1    ; If not, keep looking
    LD    A,(HL)        ; Get next character
    CP    ' '+1        ; Something following comma?
    JR    NC,WHLTRUE    ; If so, we have a list
    JR    AMBFALSE

     ENDIF    ; LISTOPT

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

;  Condition:  SHELL
;
;    This test returns true if anything is on the shell stack.  It returns
;    a false condition if there is no shell stack.  If XSHELLOPT equate is
;    true, then the following optional syntax is supported:
;
;            IF SHELL NAME
;
;    With this form, the code will compare the given NAME with the program
;    name on the top of the shell stack.  Any leading DU: or DIR: will be
;    skipped, both in NAME and in the shell stack entry.  Wild cards are
;    allowed in NAME.

     IF    SHELLOPT

IFCSHELL:
    CALL    GETSH1        ; Get shell stack info
    JP    Z,IFCFALSE    ; False if no shell stack
    LD    A,(HL)        ; See if anything on stack
    OR    A
    JR    Z,AMBFALSE    ; False if not

     IF    XSHELLOPT    ; Extended shell option

    LD    DE,FCB1        ; Parse shell stack entry into FCB1
    XOR    A        ; Scan DIR: before DU:
    CALL    ZFNAME
    CALL    SKIP2        ; Point to second command-line token
    JP    Z,IFCTRUE    ; If no second token, set state to true
    LD    DE,FCB2        ; Else parse token into FCB2
    XOR    A        ; Scan DIR: before DU:
    CALL    ZFNAME
    LD    HL,FCB1+9    ; Force match in file types
    LD    B,3        ; ..by setting type to '???'
IFCSHELL0:
    LD    (HL),'?'
    INC    HL
    DJNZ    IFCSHELL0

    LD    HL,FCB1+1    ; Compare name in FCB1 to that in FCB2
    JP    IFCEQ

     ENDIF    ; XSHELLOPT

    JR    WHLTRUE        ; Otherwise true

     ENDIF    ; SHELLOPT

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

;  Condition:  ZEX
;
;    This test returns true if ZEX is currently running.  If no message
;    buffer is implemented, it returns false.

     IF    ZEXOPT

IFCZEX:
    CALL    GETZRUN        ; See if ZEX running
    JR    C,AMBFALSE    ; If no message buffer, take as false
    JR    Z,AMBFALSE    ; If ZEX not running, set false
    JR    WHLTRUE        ; Otherwise, set true

     ENDIF    ; ZEXOPT

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

; Condition:  TAG <file list> <n>

;    This test returns true if each file in the list exists and if
;    byte n, (1 <= n >= 8), of the file's name in the directory has its
;    msb set.

     IF    TAGOPT

IFCTAG:
    CALL    SKIP2        ; Skip to second token
    CALL    SKNSP        ; Skip over it
    CALL    SKSP        ; ..to third token
    CALL    GETNUM        ; Get byte to test
    LD    A,B        ; Byte number in A
    OR    A
    JR    Z,TAGERR    ; Error if number more than 255
    CP    8+1        ; Must not be > 8
    JR    C,TAG1

TAGERR:
    CALL    PRINT
    DEFB    ' Bad tag',0
    JP    ERRORMSG

     ENDIF    ; TAGOPT

     IF    ATTROPTS

TAG1:
    LD    (OFFSET),DE    ; Store offset to tag byte
    CALL    NEGCOMPL    ; Reverse sense of true/false if negated
    LD    HL,ATTRTST    ; Get return to call
    LD    (TSTCALL),HL    ; Modify call instruction
    JR    IFCEM0        ; Go to modified empty test

; Return to test for file attribute set.  On entry, regiter D
; points to the FCB.

ATTRTST:
    LD    HL,(OFFSET)    ; Get offset into HL
    ADD    HL,DE        ; Now pointing at desired byte
    LD    A,(HL)
    RLCA            ; Get msb into carry
    JP    NC,IFCTRUE    ; False if not set (sense reversed)
    RET

     ENDIF    ; ATTROPTS

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

; Condition:  RO <file list>

;    This test returns true if all files in the list are set
;    to read-only.

     IF ROOPT

     IFCRO:
    LD    DE,9        ; Offset to R/O flag
    JR    TAG1        ; Go perform function

     ENDIF    ; ROOPT

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

; Condition:  SYS <file list>

;    This test returns true if all files in the list are set
;    to system.

     IF    SYSOPT

     IFCSYS:
    LD    DE,10        ; Offset to SYS flag
    JR    TAG1        ; Go perform function

     ENDIF    ; SYSOPT

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

; Condition:  ARCHIVE <file list>

;    This test returns true if all files in the list are set
;    to archive.

     IF    ARCOPT

     IFCARC:
    LD    DE,11        ; Offset to ARC flag
    JR    TAG1        ; Go perform function

     ENDIF    ; ARCOPT

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

; Condition: EXIST <file list>
;
;    A list of ambiguous file names separated by commas (no spaces allowed)
;    may be given.  If at least one file from each ambiguous file
;    specification exists, then the if state will be set to true.  As soon
;    as one ambiguous file specification fails to match an existing file
;    the condition is set to false.

IFCEXIST:
    CALL    NEGCOMPL    ; Reverse the sense of testing (vs EM test)
    LD    HL,JUSTRET    ; Modify call in empty test
    LD    (TSTCALL),HL
    JR    IFCEM0        ; Go to modified empty test


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

; Condition: EMPTY filename.typ
;
;    This test is like a NOT EXIST test except that existence is taken to
;    require not only a directory entry for a file but also some contents
;    to the file.  If ANY tested filespec is nonexistent or empty, then the
;    if state is set to true.  If ALL files do exist and contain data, then
;    the state is set to false.
;
;    The stack is not always cleaned up here, but that is no problem.

IFCEMPTY:
    LD    HL,READREC    ; Addr of rtn to execute
    LD    (TSTCALL),HL    ; Modify call instruction

ifcem0:
    CALL    SKIP2        ; Skip to 2nd token
    JP    Z,IFCTRUE    ; TRUE if none

; Loop through files in list

IFCEM1:
    LD    DE,FCB1        ; Point to FCB1
    CALL    ZFNAME        ; Convert string to filespec
    PUSH    HL        ; Save pointer to file list string
    CALL    TLOG        ; Log into FCB1's DU
    LD    DE,FCB1        ; Try to open file
    LD    C,15
    PUSH    DE        ; Save FCB pointer
    CALL    BDOS
    POP    DE
    INC    A        ; Z if not found
    JR    Z,IFCTRUE    ; If not found, set true if state

TSTCALL    EQU    $+1        ; Pointer for in-code modification
    CALL    0        ; Perform function

IFCEM2:                ; File exists (and has contents if EM test)
                ; ... or has specified attribute
    POP    HL        ; Get back pointer to file list
    LD    A,(HL)        ; Check for additional files on list
    INC    HL
    CP    ','        ; More to come?
    JR    NZ,IFCFALSE    ; All files found, so set state to false
    LD    A,(HL)        ; Make sure not a terminal comma
    CP    ' '+1
    JR    C,IFCFALSE    ; End of list, all empty, so FALSE
    JR    IFCEM1        ; Process next item

READREC:
    LD    C,20        ; Try to read a record
    CALL    BDOS
    OR    A        ; Z if files has contents
    JR    NZ,IFCTRUE    ; If file empty, set true if state
JUSTRET:
    RET

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

; Condition: INPUT (from user)
;
;    If there is any text after the option, it is used as a prompt.  The
;    string " (Y/N)? " is automatically appended.  Any of the following
;    input from the user is taken as affirmative: CR, space, Y, or T.
;    Any other input is taken as a negative answer.

IFCINPUT:
    LD    A,CR        ; Carriage return
    CALL    COUT
    LD    A,LF        ; New line
    CALL    COUT
    CALL    STOPZEX        ; Suspend ZEX input
    LD    HL,TBUFF+1    ; See if text is given in command tail
    CALL    SKIP2        ; Skip to second token
    JR    Z,IFCIN2    ; If end of line, use default 'IF True?'

    CALL    ECHO        ; Echo the rest of line with case and control
                ; ..character interpretation
;    CALL    PRINT        ; Append the following
;    DEFB    ' (Y/N)? ',0
    JR    IFCIN3

IFCIN2:
    CALL    PRINT
    DEFB    ' IF True? ',0

IFCIN3:
    CALL    CAPINE
    CALL    STRTZEX        ; Resume ZEX input
    CP    'T'        ; True?
    JR    Z,IFCTRUE
    CP    'Y'        ; Yes?
    JR    Z,IFCTRUE
    CP    CR        ; New line?
    JR    Z,IFCTRUE
    CP    ' '        ; Space?
    JR    Z,IFCTRUE
    JR    IFCFALSE


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

; Condition: ERROR
;
;    This tests the program error flag.  If it has a value of zero, then
;    the if state is set to false.  If the value is nonzero, then an error
;    condition is assumed to exist, and the if state is set to true.
;    If the equate XERROPT is true, then the following form will also be
;    processed:
;            IF ERROR VALUE
;
;    The if state will be set true only if the program error flag has that
;    specified value.

IFCERROR:

     IF    XERROPT        ; Extended ERROR option

    CALL    SKIP2        ; Move to second token
    LD    B,0        ; Default reference value
    JR    Z,IFCERR1    ; If no second token, use default
    CALL    NEGCOMPL    ; Complement sense of testing
    CALL    GETNUM        ; Convert token to number in B
IFCERR1:
    CALL    GETER2        ; Get error flag value
    CP    B
    JR    NZ,IFCTRUE
    JR    IFCFALSE

     ELSE    ; NOT XERROPT

    CALL    GETER2        ; Get error byte
    JP    NZ,IFCTRUE
    JP    IFCFALSE

     ENDIF    ; XERROPT


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

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

IFCTRUE:
    LD    A,(NEGFLAG)    ; Check for negation of test
    OR    A
    JR    NZ,IFCF        ; Make IF FALSE
IFCT:
    CALL    IFT        ; Make IF TRUE
    JR    NZ,RETURN
    JR    IFOVFL

IFCFALSE:
    LD    A,(NEGFLAG)    ; Check for negation of test
    OR    A
    JR    NZ,IFCT        ; Make IF TRUE
IFCF:
    CALL    IFF        ; Make IF FALSE
    JR    NZ,RETURN

IFOVFL:
    CALL    PRINT
    DEFB    BEL
    DEFB    ' IF Overflow',0

RETURN:
    LD    SP,(STACK)    ; Restore system stack
    RET            ; ..and return to operating system

ERRORMSG:            ; Return from errors with if state false
    CALL    PRINT
    DEFB    BEL,
    DEFB    ' --- Setting FALSE if State'
    DEFB    0
    JR    IFCF

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


; Save TBUFF and skip to 2nd token

SKIP2:
    LD    DE,TBUFF+1    ; Pt to first char
    CALL    CODEND        ; Pt to free area
    PUSH    HL

SKIP2A:                ; Copy command line tail to buffer area
    LD    A,(DE)        ; Get next char
    LD    (HL),A        ; Save it
    INC    HL        ; Pt to next
    INC    DE
    OR    A        ; Done?
    JR    NZ,SKIP2A

    POP    HL        ; Point to command line tail again
    CALL    SKSP        ; Skip over spaces
    CALL    SKNSP        ; Skip over 1st token
    CALL    SKSP        ; Skip over spaces

    LD    A,(HL)        ; Get 1st char of 2nd
    OR    A        ; Return with Z if none
    RET

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

; Convert chars pointed to by HL into a byte-length number in B.  Give an error
; message if the value is not in byte range.

GETNUM:
    CALL    EVAL        ; Evaluate
    LD    B,E        ; Move low-byte value to B
    LD    A,D        ; Check high byte for zero
    OR    A
    RET    Z        ; Return if no overflow to high byte

NUMERROR:
    CALL    PRINT        ; Print error message and return with false
    DEFB    ' Bad number',0
    JR    ERRORMSG

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

; Log into DU in FCB1

TLOG:
    LD    A,(FCB1)    ; 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,(FCB1+13)    ; Pt to user
    LD    E,A
    LD    C,32        ; Set user
    JP    BDOS

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

; Try to evaluate the first token in the tail as a register number.  There
; are some complications as a result of allowing nondecimal numbers.  We
; check for condition 'EX' separately, and we also require that the entire
; token be a number (no extra characters).  Otherwise EVAL can return a
; zero value for miscellaneous strings.

REGTEST:
    LD    H,D        ; Move DE into HL for EVAL
    LD    L,E
    LD    A,(DE)        ; Check for special case of 'EX'
    CP    'E'        ; ..which can be mistaken for
    JR    NZ,REGTEST1    ; ..a hex number 0EH
    INC    DE
    LD    A,(DE)
    CP    'X'
    RET    Z        ; If we have 'EX' condition, return

REGTEST1:
    CALL    EVAL        ; Try to evaluate a number
    RET    C        ; Carry flag set if bad number

    LD    A,(HL)        ; If we are not at end of token
    CP    ' '+1        ; ..then we do not have a number
    RET    NC

    LD    A,E        ; Get low byte of number
    CP    10        ; If low byte >=10
    JR    NC,REGERROR    ; ..then it's out of range

    LD    A,D        ; Get high byte of number
    OR    A        ; If high byte  >0,
    JR    NZ,REGERROR    ; ..then it's out of range

    LD    B,E        ; Get register number into B
    CALL    GETREG        ; Get value of register into A
    PUSH    AF        ; Save value
    CALL    SKIP2        ; Point to second command line token
    CALL    GETNUM        ; Convert it to a number
    POP    AF        ; Get value
    CP    B        ; Compare against extracted value
    JP    Z,IFCTRUE    ; TRUE if match
    JP    IFCFALSE    ; FALSE if non-match

REGERROR:
    CALL    PRINT
    DEFB    ' Bad register number'
    DEFB    0
    JP    ERRORMSG    ; Return with false if

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

; 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    ; Point to condition table
CONDT0:
    LD    A,(HL)        ; End of table?
    OR    A
    RET    Z
    LD    A,(DE)        ; Get first char of specified condition
    LD    B,(HL)        ; Get first char of table option into B
    INC    HL        ; Point to next characters
    INC    DE
    CP    B        ; Compare entries
    JR    NZ,CONDT2    ; Branch on mismatch
    LD    A,(DE)        ; Get 2nd char of given option
    OR    A        ; If not null
    JR    NZ,CONDT1    ; ..jump on
    LD    A,' '        ; Otherwise substitute a space
CONDT1:
    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
    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
    JR    CONDT0

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

; This routine moves ARG1 into FCB1 and parses the third command line token
; into FCB2.  On exit, HL is pointing to the name in FCB1.

     IF    XCOMP

SETCOMPARE:
    LD    HL,FCB2+1    ; Move name in FCB2 to FCB1
    LD    DE,FCB1+1
    LD    BC,11
    LDIR
    CALL    SKIP2        ; Find third token in command tail
    CALL    SKNSP        ; ..skip over second token
    CALL    SKSP        ; ..skip to beginning of third token
    LD    DE,FCB2        ; Parse token into FCB2
    XOR    A        ; ..using DIR form before DU
    CALL    ZFNAME
    LD    HL,FCB1+1    ; Compare first FCB to second
    RET

     ENDIF    ; XCOMP

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

; FCB Comparison Subroutine
;
;    Returns with:
;        Z     if FCBs are the same (wild cards are
;            treated as equality)
;        NZ    if FCBs are different
;        C & NZ    if FCB1 is greater than FCB2
;        NC & NZ    if FCB2 is greater than FCB1

COMPARE:
    LD    DE,FCB2+1
    LD    B,11        ; 11 chars
COMPARE1:
    LD    A,(DE)        ; Compare
    CP    '?'        ; See if an AFN was specified
    JR    Z,COMPARE2    ; Always match a ?
    LD    C,A        ; Save it in C temporarily
    LD    A,(HL)        ; Get the other character
    CP    '?'        ; See if it is a ?
    JR    Z,COMPARE2    ; If so accept it as a match
    CP    C
    RET    NZ        ; Return nonzero if no match
COMPARE2:
    INC    HL        ; Advance
    INC    DE
    DJNZ    COMPARE1    ; Count down
    RET            ; Return zero if match

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

; This routine complements the negation flag to reverse the sense of testing.

NEGCOMPL:
    LD    A,(NEGFLAG)    ; Get current flag
    CPL            ; Complement it
    LD    (NEGFLAG),A    ; Save new value
    RET

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

; This subroutine echoes the null-terminated string pointed to by HL to the
; console.  The special symbol '^' in the string converts the following
; character to a control character.  The special symbol '%' flags a special
; function.  If followed by '<', output switches to upper case; if followed by
; '>', output switches to lower case.  Other characters following the '%' are
; echoed as is.

ECHO:
    XOR    A        ; Lower case flag setting

     IF    UPCASE        ; If upper case default
    DEC    A
     ENDIF

    LD    (CASEFL),A    ; Store flag in code below

ECHO1:
    CALL    GETCHAR        ; Get next character (returns if end of string)
    CP    '^'        ; Control character leadin?
    JR    NZ,ECHO2    ; Branch if not

    CALL    GETCHAR        ; Get next character
    AND    1FH        ; Convert to control character
    JR    ECHO4        ; Echo it

ECHO2:
    CP    '%'        ; Case shift prefix?
    JR    NZ,ECHO4    ; Branch if not

    CALL    GETCHAR        ; Get next character
    CP    UCASECH        ; Up-shift character?
    JR    Z,ECHO3        ; Store non-zero value in case flag

    CP    LCASECH        ; Lower-case character?
    JR    NZ,ECHO4    ; If not, echo the character as is

    XOR    A        ; Else, clear case flag
ECHO3:
    LD    (CASEFL),A
    JR    ECHO1        ; On to next character

ECHO4:
    LD    C,A        ; Save real character in C
    CP    'A'        ; Branch to ECHO5 if not in range A..Z
    JR    C,ECHO5
    CP    'Z'+1
    JR    NC,ECHO5
    ADD    20H        ; Make a lower case version
ECHO5:
    LD    D,A        ; Save lower case version in D
CASEFL    EQU    $+1        ; Pointer for in-the-code modification
    LD    A,0
    OR    A        ; Clear Z flag if upper case
    LD    A,C        ; Get upper case version of character
    JR    NZ,ECHO6    ; If upper case selected, go on as is
    LD    A,D        ; Else substitute lower case version
ECHO6:
    CALL    COUT        ; Output the character and return
    JR    ECHO1        ; Back to process next character

GETCHAR:
    LD    A,(HL)        ; Get character
    INC    HL        ; Point to next one
    OR    A        ; Check for end of string
    RET    NZ        ; If not end, return to caller
    POP    HL        ; Else, clean up stack
    RET            ; ..and exit from main routine

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

; Buffers

     IF    USEDSEG
    DSEG
     ENDIF    ; USEDSEG

     IF ATTROPTS
OFFSET:
    DEFS    2        ; Storage for attribute offset
     ENDIF            ; Attropts

NEGFLAG:
    DEFS    1        ; Negation flag

    DEFS    2*25        ; Space for local stack
STACK:    DEFS    2        ; Place to save system stack

    END