home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / ZCPR33 / Z3-33 / Z33IF14.LBR / IF14.ZZ0 / IF14.Z80
Text File  |  2000-06-30  |  46KB  |  1,726 lines
  1. ; Program: Z33IF
  2. ; Author: Jay Sage
  3. ; Version: 1.0
  4. ; Date: May 17, 1987
  5. ; Derivation: COMIF10
  6.  
  7.  
  8. ;            * * *   IMPORTANT NOTE   * * *
  9. ;
  10. ; This program is copyrighted 1987 by Jay Sage and Echelon, Inc.  It may be
  11. ; copied and modified freely for personal use but may not be sold or distributed
  12. ; for a fee.  Modified versions may not be distributed unless submitted to and
  13. ; approved by Echelon, Inc.
  14.  
  15.  
  16. ;=============================================================================
  17. ;
  18. ;            R E V I S I O N   H I S T O R Y
  19. ;
  20. ;=============================================================================
  21.  
  22. VERSION    EQU    14
  23.  
  24. ; 04/12/88    Fixed two related bugs in the code for the EXists,
  25. ;        EMpty and file attributes tests.  Now keeps track of
  26. ;        default directory and correctly handles file names with
  27. ;        leading colons.
  28. ;                Howard Goldstein
  29. ;
  30. ;        Added ENVTYPE equate.  When set to 3, the long protection
  31. ;        code that checks the load address is included.  When set to
  32. ;        4, the RST 0 protection is used.  The type-3 form will allow
  33. ;        the program to be used with the standard Z33 FCP.
  34.  
  35. Z33IF13
  36. ; 09/02/87    Changed the entry construct to 'new' Types 3 and 4.
  37. ; Z33IF12    Moved 'free memory' below the code for Type 4.
  38. ;                Joe Wright
  39.  
  40. ; 08/31/87    Added an additional assembly type option equate EXCLEQ to
  41. ; Z33IF11    allow exclusion of the extended '=' syntax because of its
  42. ;        conflict with the "A=B" syntax when the latter has a null
  43. ;        first token.
  44.  
  45. ; 05/17/87    Modified for use with ZCPR33 and Z33FCP.  Now has a type-3
  46. ; Z33IF10    envronment and uses value of environment passed in HL register.
  47. ;
  48. ; 03/10/87    Creation of COMIF program from IF.
  49. ;   1.0
  50. ;        Hex/binary/octal numerical inputs implemented for all number
  51. ;        entry.
  52. ;
  53. ;        "IF INPUT" prompt text has controls to generate control
  54. ;        character output and upper/lower case text.  A '^' converts
  55. ;        the following character to a control character.  The sequence
  56. ;        '%<' toggles output to upper case; '%>' toggles to lower case.
  57. ;
  58. ;        Added following tests:
  59. ;            IF AMBIG    tests for file ambiguity
  60. ;            IF ARCHIVE    tests for file archive attribute
  61. ;            IF BG        tests for presence of BackGrounder
  62. ;            IF COMPR    tests for squeezed or crunched file
  63. ;            IF DS        tests for presence of DateStamper
  64. ;            IF LIST        tests for items separated by commas
  65. ;            IF RO        test for file R/O attribute
  66. ;            IF SHELL    tests for shell on stack
  67. ;            IF SYS        tests for file SYS attribute
  68. ;            IF TAG        tests for tag attribute (tag specified
  69. ;                    following file names, i.e
  70. ;                    IF TAG FILE.EXT 3)
  71. ;            IF ZEX        tests for ZEX running
  72. ;
  73. ;        Added more general equality/inequality testing options for
  74. ;        strings.  If XCOMP1 is true, the following conditions are
  75. ;        recognized: EQ, NE, GT, GE, LT, LE.  All can be negated with ~.
  76. ;        If XCOMP2 is true, the following conditions are also allowed:
  77. ;        =   <>   ><   >   >=   <   <=.  All can be negated with '~'.
  78. ;
  79. ;        Added extended register and value testing options (if REGVALOPT
  80. ;        is true).  Syntax forms are:
  81. ;
  82. ;            IF [~]REG REG# OPERATOR VALUE
  83. ;            IF [~]VALUE ARG1 OPERATOR ARG2
  84. ;
  85. ;        VALUE compares two 16-bit numerical arguments; REG treats the
  86. ;        first argument as a register number rather than a value.
  87. ;        Spaces are optional surrounding the operator, and the following
  88. ;        operators are recognized:  =   <>   ><   >   >=   <   <=.
  89. ;        Here are some examples:
  90. ;
  91. ;            IF REG 3 > 1CH        IF REG 9= 0
  92. ;            IF REG 3 <>1101B    IF ~REG 011B=15Q
  93. ;            IF VAL C000H > 40000
  94. ;
  95. ;        Added many optional extensions to conditions.  IF TCAP can now
  96. ;        test for a specific TCAP using the syntax IF TCAP STRING.  The
  97. ;        string may have '?' wild cards in it.  The TCAP ID string is
  98. ;        compared to the given string up to the length of the latter.
  99. ;
  100. ;        Specific error conditions can be tested using the optional
  101. ;        syntax IF ERROR VALUE.
  102. ;
  103. ;        One can test for a particular shell program on the top of the
  104. ;        stack using IF SHELL NAME, where NAME may be ambiguous.
  105. ;
  106. ;        Modified EXIST and EMPTY tests to share code and meaning.  The
  107. ;        two tests are now the same except that (1) the EX test only
  108. ;        checks for the presence of a directory entry while EM also
  109. ;        checks for contents and (2) the senses of the tests are
  110. ;        reversed (EX is true if all files in list exist; EM is false
  111. ;        if all files exist and have contents.  Thus ~EM is equivalent
  112. ;        to EX but with a more stringent existence requirement).  Note
  113. ;        that when the file list has ambiguous filespecs, only the
  114. ;        first matching file is checked.
  115. ;
  116. ;        I would like to acknowlege extensive contributions to the
  117. ;        coding of COMIF by Howard Goldstein.
  118. ;
  119. ;                Jay Sage
  120.  
  121.  
  122. ; HISTORY OF IF.COM VERSIONS FROM WHICH THIS PROGRAM WAS DERIVED
  123.  
  124. ; 12/09/85    Fixed shortcoming in IF NULL test.  We now do it by checking
  125. ;   1.4        the command tail for characters.  IF NULL will now return false
  126. ;        if the second token is any kind of drive/user or named
  127. ;        directory specification as well as a file name.
  128. ;                Jay Sage
  129.  
  130. ; 09/06/85    Fixed mistake in IF ERROR code.  It was testing the error
  131. ;   1.3        handler flag instead of the program error flag.  Also enhanced
  132. ;        IF INPUT.  If text follows the INPUT token, then this text is
  133. ;        echoed to the console followed by ' (Y/N)? '.  If there is no
  134. ;        text, IF IN works as before.
  135. ;                Jay Sage
  136.  
  137. ; IF is intended to be invoked from the IF routine in an FCP.  This program
  138. ; implements the IF conditional tests and sets the next level of IF to be TRUE
  139. ; or FALSE.
  140. ; 
  141. ; Modified on 02/11/85 to accept ambiguous file names and match them. This 
  142. ; allows aliases to add file extensions if they are needed, for instance 
  143. ; if there is an alias LDIR that gets a directory of an .LBR file, it 
  144. ; previously had to be defined as an example :
  145.  
  146.  
  147.  
  148. ; Configuration Equates
  149.  
  150. NO        EQU    0
  151. YES        EQU    NOT NO
  152.  
  153. ; SLR version (for non-SLR-compatible assembler, delete the .ACCEPT line and
  154. ; remove the semicolon from the ENVTYPE equate.
  155.  
  156. .ACCEPT    "Enter ENV type (3 or 4): ",ENVTYPE
  157.  
  158. ;ENVTYPE    EQU    3    ; If 3, then address checking protection code
  159.                 ; included; if 4, then RST 0 protection used
  160.  
  161. USEDSEG        EQU    YES    ; Yes to put uninitialized data in a data
  162.                 ; segment (special linking required)
  163.  
  164. UPCASE        EQU    YES    ; Default to upper case output with IF IN
  165.                 ; ..prompt string
  166. UCASECH        EQU    '<'    ; Character to toggle to upper case output
  167. LCASECH        EQU    '>'    ; Character to toggle to lower case output
  168.  
  169. COMPROPT    EQU    YES    ; Include compressed file test
  170.  
  171. LISTOPT        EQU    YES    ; Include IF LIST test
  172.  
  173. TAGOPT        EQU    YES    ; Include IF TAG test
  174. ARCOPT        EQU    YES    ; Include IF ARCHIVE test
  175. ROOPT        EQU    YES    ; Include IF RO test
  176. SYSOPT        EQU    YES    ; Include IF SYS test
  177. ATTROPTS    EQU    TAGOPT OR ARCOPT OR SYSOPT OR ROOPT
  178.  
  179. SHELLOPT    EQU    YES    ; Include IF SHELL test
  180. ZEXOPT        EQU    YES    ; Include IF ZEX test
  181. REGVALOPT    EQU    YES    ; Include IF REG and IF VAL tests
  182.  
  183. PLUPERFOPT    EQU    YES    ; Include IF BG and IF DS tests
  184. IDOFF        EQU    5BH    ; Offset to BG ID in CCP
  185.  
  186. XERROPT        EQU    YES    ; Include extended ERROR option (IF ER VALUE)
  187. XTCAPOPT    EQU    YES    ; Include extended TCAP option (IF TC STRING)
  188. XSHELLOPT    EQU    YES    ; Include extended SHELL option (IF SHELL NAME)
  189. XCOMP1        EQU    YES    ; Include extended comparision tests EQ, NE,
  190.                 ; ..GT, GE, LT, LE
  191. XCOMP2        EQU    YES    ; Include extended comparison tests '=', '<>'
  192.                 ; '><', '>', '>=', '<', '<="
  193. EXCLEQ        EQU    YES    ; Exclude extended comparison test '=' (that
  194.                 ; ..test can conflict with "A=B" syntax when
  195.                 ; ..the first item is null)
  196. XCOMP        EQU    XCOMP1 OR XCOMP2
  197.  
  198. NEGCHAR     EQU    '~'    ; Negation prefix char
  199.  
  200.  
  201. ; Miscellaneous Equates
  202.  
  203. BDOS    EQU    5
  204. FCB1    EQU    5CH
  205. FCB2    EQU    6CH
  206. TBUFF    EQU    80H
  207. CR    EQU    0DH
  208. LF    EQU    0AH
  209. TAB    EQU    09H
  210. BEL    EQU    07H
  211.  
  212.  
  213. ; External Z3LIB and SYSLIB Routines
  214.  
  215.     EXT    Z3INIT,STRTZEX,STOPZEX,GETZRUN,GETER2,GETREG
  216.     EXT    IFT,IFF,GETENV,GETWHL,GETSH1,ZFNAME
  217.  
  218.     EXT    EVAL,PSTR,PRINT,CAPINE,CODEND,SKSP,SKNSP,COUT,CAPS
  219.     EXT    COMPHD,PHL4HC,GETUD,PUTUD
  220.  
  221.  
  222. ; External ZCPR3 Environment Descriptor
  223.  
  224. ENTRY:
  225.      IF    ENVTYPE EQ 3
  226.  
  227.     JR    START0
  228.     DEFB    0
  229.  
  230.      ELSE ;TYPE 4
  231.  
  232.     RST    0        ; Warmboot protection
  233.     DW    START        ; New Type 3 construct  JWW
  234.  
  235.      ENDIF    ;ENVTYPE EQ 3
  236.  
  237.     DEFB    'Z3ENV'        ; This is a ZCPR3 Utility
  238. TYPE:
  239.     DEFB    ENVTYPE        ; Type-3 Environment Descriptor
  240. Z3EADR:
  241.     DEFW    0
  242.     DEFW    ENTRY
  243.  
  244.      IF    ENVTYPE EQ 3
  245.  
  246. START0:
  247.     LD    (Z3EADR),HL    ; Save environment address passed in HL
  248.  
  249.     ld    hl,0        ; Point to warmboot entry
  250.     ld    a,(hl)        ; Save the byte there
  251.     di            ; Protect against interrupts
  252.     ld    (hl),0c9h    ; Replace warmboot with a return opcode
  253.     rst    0        ; Call address 0, pushing RETADDR onto stack
  254. retaddr:
  255.     ld    (hl),a        ; Restore byte at 0
  256.     dec    sp        ; Get stack pointer to point
  257.     dec    sp        ; ..to the value of RETADDR
  258.     pop    hl        ; Get it into HL and restore stack
  259.     ei            ; We can allow interrupts again
  260.     ld    de,retaddr    ; This is where we should be
  261.     xor    a        ; Clear carry flag
  262.     push    hl        ; Save address again
  263.     sbc    hl,de        ; Subtract -- we should have 0 now
  264.     pop    hl        ; Restore value of RETADDR
  265.     jp    z,start        ; If addresses matched, begin real code
  266.  
  267.     ld    de,notz33msg-retaddr ; Offset to message
  268.     add    hl,de
  269.     ex    de,hl        ; Switch pointer to message into DE
  270.     ld    c,9
  271.     jp    0005h        ; Return via BDOS print string function
  272.  
  273. notz33msg:
  274.     defb    'Not Z33+$'    ; Abort message if not Z33-compatible
  275.  
  276.      ENDIF    ;ENVTYPE EQ 3
  277.  
  278. CONDTAB:
  279.  
  280.     DEFB    'T '        ; Set state to TRUE
  281.     DEFW    IFCTRUE
  282.  
  283.     DEFB    'F '        ; Set state to FALSE
  284.     DEFW    IFCFALSE
  285.  
  286.     DEFB    'AM'        ; Test for ambiguous file specification
  287.     DEFW    IFCAMBIG
  288.  
  289.      IF    ARCOPT
  290.     DEFB    'AR'        ; Test for archive attribute
  291.     DEFW    IFCARC
  292.      ENDIF    ; ARCOPT
  293.  
  294.      IF    PLUPERFOPT
  295.     DEFB    'BG'        ; Test for BackGrounder loaded
  296.     DEFW    IFCBG
  297.      ENDIF    ; PLUPERFOPT
  298.  
  299.      IF    COMPROPT
  300.     DEFB    'CO'        ; Test for squeezed or crunched file
  301.     DEFW    IFCCOMPR
  302.      ENDIF    ; COMPROPT
  303.  
  304.      IF    PLUPERFOPT
  305.     DEFB    'DS'        ; Test for DateStamper loaded
  306.     DEFW    IFCDS
  307.      ENDIF    ; PLUPERFOPT
  308.  
  309.     DEFB    'EM'        ; Test for empty file(s)
  310.     DEFW    IFCEMPTY
  311.  
  312.     DEFB    'ER'        ; Test state of program error flag
  313.     DEFW    IFCERROR
  314.  
  315.     DEFB    'EX'        ; Test for existence of file(s)
  316.     DEFW    IFCEXIST
  317.  
  318.     DEFB    'IN'        ; Get user input
  319.     DEFW    IFCINPUT
  320.  
  321.      IF    LISTOPT
  322.     DEFB    'LI'        ; Test for multiple item token
  323.     DEFW    LIST
  324.      ENDIF    ; LISTOPT
  325.  
  326.     DEFB    'NU'        ; Test for null argument
  327.     DEFW    IFCNULL
  328.  
  329.      IF    REGVALOPT
  330.     DEFB    'RE'        ; Test register values
  331.     DEFW    IFCREG
  332.      ENDIF    ; REGVALOPT
  333.  
  334.      IF    ROOPT
  335.     DEFB    'RO'        ; Test for read-only attribute
  336.     DEFW    IFCRO
  337.      ENDIF    ; ROOPT
  338.  
  339.      IF    SHELLOPT
  340.     DEFB    'SH'        ; Test for shell name on shell stack
  341.     DEFW    IFCSHELL
  342.      ENDIF    ; SHELLOPT
  343.  
  344.      IF    SYSOPT
  345.     DEFB    'SY'        ; Test for sys file attribute
  346.     DEFW    IFCSYS
  347.      ENDIF    ; SYSOPT
  348.  
  349.      IF    TAGOPT
  350.     DEFB    'TA'        ; Test for tag attributes
  351.     DEFW    IFCTAG
  352.      ENDIF    ; TAGOPT
  353.  
  354.     DEFB    'TC'        ; Test for Z3TCAP entry loaded
  355.     DEFW    IFCTCAP
  356.  
  357.      IF    REGVALOPT
  358.     DEFB    'VA'        ; Compare numerical values
  359.     DEFW    IFCVAL
  360.      ENDIF    ; REGVALOPT
  361.  
  362.     DEFB    'WH'        ; Test if wheel byte set
  363.     DEFW    IFCWHEEL
  364.  
  365.      IF    ZEXOPT
  366.     DEFB    'ZE'        ; Test if ZEX running
  367.     DEFW    IFCZEX
  368.      ENDIF    ; ZEXOPT
  369.  
  370.      IF    XCOMP1
  371.     DEFB    'EQ'        ; Test for equality
  372.     DEFW    IFCEQUAL
  373.     DEFB    'NE'        ; Test for nonequality
  374.     DEFW    IFCNOTEQUAL
  375.     DEFB    'GE'        ; Test for ARG1 greater than or equal to ARG2
  376.     DEFW    IFCGTOREQ
  377.     DEFB    'GT'        ; Test for ARG1 greater than ARG2
  378.     DEFW    IFCGREATER
  379.     DEFB    'LT'        ; Test for ARG1 less than ARG2
  380.     DEFW    IFCLESS
  381.     DEFB    'LE'        ; Test for ARG1 less than or equal to ARG2
  382.     DEFW    IFCLTOREQ
  383.      ENDIF    ; XCOMP1
  384.  
  385.      IF    XCOMP2
  386.      IF    NOT EXCLEQ    ; If not excluding extended '=' syntax
  387.     DEFB    '= '        ; Test for equality
  388.     DEFW    IFCEQUAL
  389.      ENDIF    ; NOT EXCLEQ
  390.     DEFB    '<>'        ; Test for nonequality
  391.     DEFW    IFCNOTEQUAL
  392.     DEFB    '><'        ; Test for nonequality
  393.     DEFW    IFCNOTEQUAL
  394.     DEFB    '>='        ; Test for ARG1 greater than or equal to ARG2
  395.     DEFW    IFCGTOREQ
  396.     DEFB    '> '        ; Test for ARG1 greater than ARG2
  397.     DEFW    IFCGREATER
  398.     DEFB    '< '        ; Test for ARG1 less than ARG2
  399.     DEFW    IFCLESS
  400.     DEFB    '<='        ; Test for ARG1 less than or equal to ARG2
  401.     DEFW    IFCLTOREQ
  402.      ENDIF    ; XCOMP2
  403.  
  404.     DEFB    0
  405.  
  406.  
  407. ; Start of program -- initialization
  408.  
  409. START:
  410.      IF    ENVTYPE EQ 3
  411.     LD    HL,(Z3EADR)
  412.      ENDIF
  413.  
  414.     LD    (STACK),SP    ; Save system stack pointer
  415.     LD    SP,STACK    ; Set up local stack
  416.     CALL    Z3INIT        ; Initialize the ZCPR3 Environment
  417.     XOR    A        ; Clear negation flag
  418.     LD    (NEGFLAG),A
  419.  
  420. ; Test for ARG1=ARG2 syntax (as single token with no spaces)
  421.  
  422.     LD    HL,TBUFF+1    ; Point to command tail
  423.     CALL    SKSP        ; Start at first token
  424.     LD    D,H        ; Copy HL into DE for use at IFCK0
  425.     LD    E,L
  426.     LD    A,(HL)        ; Check for no tail
  427.     OR    A
  428.     JR    Z,IFHELP    ; Show help screen if no tail
  429.  
  430.      IF    XCOMP2        ; If conditions such as '<=' are allowed
  431.     CP    '<'        ; ..check for them and go to IFCK0 if found
  432.     JR    Z,IFCK0
  433.     CP    '>'
  434.     JR    Z,IFCK0
  435.     CP    NEGCHAR
  436.     JR    Z,IFCK0
  437.      ENDIF    ; XCOMP2
  438.  
  439. ; Here we test for the "A=B" syntax.  If XCOMP2 is enabled and EXCLEQ is not
  440. ; set to exclude the extended, leading '=' test, then we have to skip the
  441. ; first character so that we do not pick up the leading equal sign.
  442.  
  443.      IF    NOT XCOMP2 OR EXCLEQ
  444.     DEC    HL        ; Compensate for INC HL in loop below
  445.      ENDIF    ; NOT XCOMP2 OR EXCLEQ
  446.  
  447. IFTEQ:
  448.     INC    HL        ; Point to next character
  449.     LD    A,(HL)        ; Get it
  450.     CP    ' '+1        ; Test for end of token
  451.     JR    C,IFCK0        ; If end, we do not have ARG1=ARG2 syntax
  452.     CP    '='        ; Have we found '='?
  453.     JR    NZ,IFTEQ    ; If not, keep looping
  454.     LD    HL,FCB1+1    ; If so, compare FCB1 to FCB2
  455.     JP    IFCEQ
  456.  
  457. ; Test for help request or negation character
  458.  
  459. IFCK0:
  460.     LD    A,(DE)        ; Get first char of first token in tail
  461.     CP    '/'        ; If explicit help request
  462.     JR    Z,IFHELP    ; ..jump to help display
  463.     CP    NEGCHAR        ; If not negation character
  464.     JR    NZ,IFCK1    ; ..then leave negflag as is
  465.     CALL    NEGCOMPL    ; Else complement the flag setting
  466.     INC    DE        ; ..and point to char after negchar
  467.  
  468. ; Test for register syntax of form "IF REG# VALUE"
  469.  
  470. IFCK1:
  471.     PUSH    DE        ; Save pointer
  472.     CALL    REGTEST        ; Will not return if "IF REG# VALUE" syntax
  473.     POP    DE
  474.  
  475. ; Scan for condition option
  476.  
  477.     CALL    CONDTEST    ; Test of condition match
  478.     JR    Z,CONDERROR    ; Error message if condition not recognized
  479.     JP    (HL)        ; Process condition testing
  480.  
  481. ; Fall-through error code
  482.  
  483. CONDERROR:
  484.     CALL    PRINT
  485.     DEFB    ' Bad IF Condition',0
  486.     JP    ERRORMSG
  487.  
  488. ; Print help message
  489.  
  490. IFHELP:
  491.     CALL    PRINT
  492.     DEFB    CR,LF,LF
  493.     DEFB    TAB,'Z33IF '
  494.     DEFB    [VERSION/10]+'0','.',[VERSION MOD 10]+'0'
  495.     DEFB    ' (C)  (Type ',0
  496.     LD    A,(TYPE)
  497.     ADD    A,'0'
  498.     CALL    COUT
  499.     CALL    PRINT
  500.     DB    ' loaded at ',0
  501.     LD    HL,ENTRY
  502. IFHLP:    CALL    PHL4HC
  503.     CALL    PRINT
  504.     DEFB    'H)'
  505.     DEFB    CR,LF,LF,'SYNTAX:',TAB,'(1) IF ARG1=ARG2'
  506.     DEFB    CR,LF,TAB,'(2) IF REGISTER# [VALUE]'
  507.     DEFB    CR,LF,TAB,'(3) IF CONDITION ARGUMENTS'
  508.  
  509.     DEFB    CR,LF,LF,'CONDITIONS:'
  510.     DEFB    CR,LF,TAB,'T, F, AMBIG'
  511.  
  512.      IF    ARCOPT
  513.     DEFB    ', ARCHIVE'
  514.      ENDIF    ; ARCOPT
  515.  
  516.      IF    PLUPERFOPT
  517.     DEFB    ', BG'
  518.      ENDIF    ; PLUPERFOPT
  519.  
  520.      IF    COMPROPT
  521.     DEFB    ', COMPR'
  522.      ENDIF    ; COMPROPT
  523.  
  524.      IF    PLUPERFOPT
  525.     DEFB    ', DS'
  526.      ENDIF    ; PLUPERFOPT
  527.  
  528.     DEFB    ', EMPTY'
  529.     DEFB    ', ERROR'
  530.     DEFB    ', EXIST'
  531.     DEFB    ', INPUT'
  532.  
  533.     DEFB    CR,LF,TAB,'NULL'
  534.  
  535.      IF    LISTOPT
  536.     DEFB    ', LIST'
  537.      ENDIF    ; LISTOPT
  538.  
  539.      IF    REGVALOPT
  540.     DEFB    ', REG'
  541.      ENDIF    ; REGVALOPT
  542.  
  543.      IF    ROOPT
  544.     DEFB    ', RO'
  545.      ENDIF    ; ROOPT
  546.  
  547.      IF    SHELLOPT
  548.     DEFB    ', SHELL'
  549.      ENDIF    ; SHELLOPT
  550.  
  551.      IF    SYSOPT
  552.     DEFB    ', SYS'
  553.      ENDIF    ; SYSOPT
  554.  
  555.      IF    TAGOPT
  556.     DEFB    ', TAG'
  557.      ENDIF    ; TAGOPT
  558.  
  559.     DEFB    ', TCAP'
  560.  
  561.      IF    REGVALOPT
  562.     DEFB    ', VALUE'
  563.      ENDIF    ; REGVALOPT
  564.  
  565.     DEFB    ', WHEEL'
  566.  
  567.      IF    ZEXOPT
  568.     DEFB    ', ZEX'
  569.      ENDIF    ; ZEXOPT
  570.  
  571.      IF    XCOMP
  572.     DEFB    CR,LF,TAB
  573.      ENDIF    ; XCOMP
  574.  
  575.      IF    XCOMP1
  576.     DEFB    'EQ NE GT GE LT LE  '
  577.      ENDIF    ; XCOMP1
  578.  
  579.      IF    XCOMP2
  580.      IF    NOT EXCLEQ
  581.     DEFB    '=  '
  582.      ENDIF    ; NOT EXCLEQ
  583.     DEFB    '<>  ><  >  >=  <  <='
  584.      ENDIF    ; XCOMP2
  585.  
  586.     DEFB    CR,LF,LF,'Only first 2 letters of condition are significant.'
  587.     DEFB    CR,LF,'A leading '
  588.     DEFB    ''''
  589.     DEFB    NEGCHAR
  590.     DEFB    ''''
  591.     DEFB    ' negates all forms except (1).'
  592.     DEFB    CR,LF
  593.     DEFB    0
  594.  
  595.     JP    RETURN
  596.  
  597.  
  598. ;=============================================================================
  599. ;
  600. ;        C O N D I T I O N    T E S T I N G
  601. ;
  602. ;=============================================================================
  603.  
  604. ; Condition:  NULL
  605. ;
  606. ;    If any text other than spaces appears on the command line after
  607. ;    the 'NULL' option, then the IF state is set to false.  This differs
  608. ;    from the IF NULL test in the SYSFCP code, which returns false
  609. ;    only when a file name is given as a second token but not when a
  610. ;    directory specification is given.
  611.  
  612. IFCNULL:
  613.     LD    HL,TBUFF+1    ; Point to command tail
  614.     CALL    SKIP2        ; Skip to second token
  615.     JR    Z,TRUEREL
  616. FALSEREL:            ; Entry point for relative jump
  617.     JP    IFCFALSE
  618.  
  619.  
  620. ;=============================================================================
  621. ;
  622. ;    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
  623. ;
  624. ;=============================================================================
  625.  
  626.      IF    PLUPERFOPT
  627.  
  628. ; Condition:  BG (BackGrounder)
  629. ;
  630. ;    This option tests for the presence of the 'BGii' ID string that
  631. ;    shows that BackGrounder ii is running.  The code looks for the
  632. ;    ID at an offset of IDOFF from the beginning of the CPR code.  The
  633. ;    value if IDOFF was determined by examination.
  634.  
  635. IFCBG:
  636.     LD    HL,(0001)        ; Get BIOS pointer
  637.     LD    DE,-1603H+IDOFF        ; Offset to 'BGii' ID string in BG CPR
  638.     ADD    HL,DE
  639.     LD    DE,IDSTR        ; Point to reference ID string
  640.     LD    B,IDLEN            ; Length of ID string
  641. BGCHK1:
  642.     LD    A,(DE)            ; Get reference character
  643.     CP    (HL)            ; Compare to actual character
  644.     JR    NZ,FALSEREL        ; Set false if mismatch
  645.     INC    HL            ; Move to next characters
  646.     INC    DE
  647.     DJNZ    BGCHK1            ; Loop through all characters
  648. BGTRUE:                    ; Entry point for relative jump
  649.     JR    TRUEREL            ; They match, so set true
  650.  
  651. IDSTR:    DEFB    'BGii'
  652. IDLEN    EQU    $ - IDSTR
  653.  
  654. ;-----------------------------------------------------------------------------
  655.  
  656. ; Condition: DS (DateStamper)
  657. ;
  658. ;    This option tests for the presence of DateStamper.
  659.  
  660. IFCDS:
  661.     LD    E,'D'            ; DateStamper ID character
  662.     LD    C,0CH            ; Return version function
  663.     CALL    BDOS
  664.     CP    22H            ; Must be CP/M 2.2
  665.     JR    NZ,FALSEREL        ; If not, set false IF state
  666.     LD    A,H            ; Check for return of ID
  667.     CP    'D'
  668.     JR    NZ,FALSEREL        ; If not, set false IF state
  669.     JR    BGTRUE            ; Otherwise set true IF state
  670.  
  671.      ENDIF    ; PLUPERFOPT
  672.  
  673.  
  674. ;=============================================================================
  675. ;
  676. ;    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
  677. ;
  678. ;=============================================================================
  679.  
  680.      IF    XCOMP        ; If extended compare options included
  681.  
  682.  
  683. ; Condition: NE (Not Equal)
  684. ;
  685. ;    This test is equivalent to ~EQ.
  686.  
  687. IFCNOTEQUAL:
  688.     CALL    NEGCOMPL    ; Complement the negation flag
  689.     JR    IFCEQUAL    ; Then perform EQ test
  690.  
  691. ;-----------------------------------------------------------------------------
  692.  
  693. ; Condition:  EQ (Equal)
  694. ;
  695. ;    This test compares the next two tokens for equality, with wildcards
  696. ;    ('?') always being taken as equality.  This code is used (at IFCEQ)
  697. ;    by the direct syntax version "IF ARG1=ARG2" and by the consistent
  698. ;    forms "IF EQ ARG1 ARG2" or "IF ~EQ ARG1 ARG2" or "IF = ARG1 ARG2"
  699. ;    and so on.
  700.  
  701. IFCEQUAL:
  702.     CALL    SETCOMPARE    ; Set up for comparison (ARG1 in FCB1,
  703.                 ; ..ARG2 in FCB2)
  704.  
  705.      ENDIF    ; XCOMP
  706.  
  707. ; Entry point for "IF ARG1=ARG2" syntax (THIS CODE IS USED EVEN IF XCOMP IS
  708. ; FALSE)
  709.  
  710. IFCEQ:
  711.     CALL    COMPARE        ; Perform comparison
  712.     JR    NZ,FALSEREL    ; False if not equal
  713. TRUEREL:            ; Entry point for relative jump
  714.     JP    IFCTRUE        ; Otherwise true
  715.  
  716. ;-----------------------------------------------------------------------------
  717.  
  718. ; Condition: LE (Less Than or Equal)
  719. ;
  720. ;    This test returns true if ARG1 is the same as or less than ARG2 in
  721. ;    the expression "IF LE ARG1 ARG2".  Wild cards are taken as equality.
  722.  
  723.      IF    XCOMP
  724.  
  725. IFCLTOREQ:
  726.     CALL    NEGCOMPL    ; Complement the negation flag
  727.     JR    IFCGREATER    ; Then use GT test
  728.  
  729. ;-----------------------------------------------------------------------------
  730.  
  731. ; Condition:  GT (Greater Than)
  732. ;
  733. ;    This test returns true if ARG1 is greater than ARG2 in the expression
  734. ;    "IF GT ARG1 ARG2".  Wild card characters are taken as equality.
  735.  
  736. IFCGREATER:
  737.     CALL    SETCOMPARE    ; Set up for comparison
  738.     CALL    COMPARE        ; Perform comparison
  739.     JR    Z,FALSEREL    ; False if equal
  740.     JR    C,FALSEREL    ; False if ARG2 (in FCB1) greater than ARG2
  741.     JR    TRUEREL        ; Otherwise true
  742.  
  743. ;-----------------------------------------------------------------------------
  744.  
  745. ; Condition:  LT (Less Than)
  746. ;
  747. ;    This test returns true if ARG1 is less than ARG2 in the expression
  748. ;    "IF LT ARG1 ARG2".  Wild card characters are taken as equality.
  749.  
  750. IFCLESS:
  751.     CALL    NEGCOMPL    ; Complement negation flag
  752.     JR    IFCGTOREQ    ; Then use GE test
  753.  
  754. ;-----------------------------------------------------------------------------
  755.  
  756. ; Condition:  GE (Greater Than or Equal)
  757. ;
  758. ;    This test returns true if ARG1 is greater than or equal to ARG2 in the
  759. ;    expression "IF GE ARG1 ARG2".  Wild card characters are taken as
  760. ;    equality.
  761.  
  762. IFCGTOREQ:
  763.     CALL    SETCOMPARE    ; Set up for comparison
  764.     CALL    COMPARE        ; Perform comparison
  765.     JR    Z,TRUEREL    ; True if equal
  766.     JR    C,FALSEREL    ; False if ARG2 (in FCB1) greater than ARG2
  767.     JR    TRUEREL        ; Otherwise true
  768.  
  769.      ENDIF    ; XCOMP
  770.  
  771. ;=============================================================================
  772. ;
  773. ;    R E G I S T E R    A N D    V A L U E    T E S T I N G
  774. ;
  775. ;=============================================================================
  776.  
  777. ; Condition:  REG
  778. ;
  779. ;    This test uses the syntax "IF [~]REG REG# OPERATOR VALUE" to test
  780. ;    values stored in user registers R#=0..9.  The allowed operators
  781. ;    are:    =    <>    ><
  782. ;        >    >=    <    <=
  783. ;    Spaces around the operators are optional.  Values may be entered in
  784. ;    decimal, octal, binary, or hexadecimal format.
  785.  
  786.      IF    REGVALOPT
  787.  
  788. IFCREG:
  789.     CALL    SKIP2        ; Skip to REG# token
  790.     CALL    GETNUM        ; Convert to a number
  791.     LD    A,9        ; Test for value not larger than 9
  792.     CP    B
  793.     JR    NC,IFCREG1    ; Jump if value is OK
  794.  
  795.     CALL    PRINT
  796.     DEFB    ' Bad register number',0
  797.     JP    ERRORMSG    ; Return with false if state
  798.  
  799. IFCREG1:
  800.     CALL    GETREG        ; Get value of designated register
  801.     LD    B,A        ; Save it in B
  802.     CALL    SKSP        ; Skip to operator (if there are spaces)
  803.     CALL    READOPER    ; Read the operator (save in register C)
  804.     CALL    SKSP        ; Skip over spaces if any to value
  805.     PUSH    BC        ; Save register value and operator
  806.     CALL    GETNUM        ; Get value for comparison into B
  807.     POP    DE        ; Restore register value to D, operator to E
  808.     LD    A,D        ; Form (REGISTERVALUE - REFERENCEVALUE)
  809.     SUB    B
  810. IFCREG1A:
  811.     PUSH    AF        ; Save result
  812.     LD    A,E        ; Branch based on operator type
  813.     CP    '='
  814.     JR    Z,IFCREG2
  815.     CP    '>'
  816.     JR    Z,IFCREG3
  817.                 ; Less-than case
  818.     POP    AF
  819.     JR    C,REGTRUE
  820. REGFALSE:            ; Entry point for relative jump
  821.     JP    IFCFALSE
  822.  
  823. IFCREG2:            ; Equal case
  824.     POP    AF
  825.     JR    Z,REGTRUE
  826.     JR    REGFALSE
  827.  
  828. IFCREG3:            ; Greater-than case
  829.     POP    AF
  830.     JR    Z,REGFALSE
  831.     JR    C,REGFALSE
  832. REGTRUE:            ; Entry point for relative jump
  833.     JP    IFCTRUE
  834.  
  835. ;-----------------------------------------------------------------------------
  836.  
  837. ;  Condition:  VAL
  838. ;
  839. ;    This option compares two 16-bit numerical values using the syntax
  840. ;    IF VAL ARG1 ARG2.
  841.  
  842. IFCVAL:
  843.     CALL    SKIP2        ; Point to ARG1
  844.     CALL    EVAL        ; Get 16-bit value into DE
  845.     JP    C,NUMERROR    ; Error if carry flag set
  846.  
  847.     PUSH    DE        ; Save ARG1 value on stack
  848.     CALL    SKSP        ; Skip to operator (if there are spaces)
  849.     CALL    READOPER    ; Read the operator (save in register C)
  850.     CALL    SKSP        ; Skip over spaces if any to value
  851.     CALL    EVAL        ; Get its value into DE
  852.     POP    HL        ; Get ARG1 value back in HL
  853.     JP    C,NUMERROR    ; Error if carry flag set
  854.  
  855.     CALL    COMPHD        ; Compare DE-HL
  856.     LD    E,C        ; Put operator character in E
  857.     JR    IFCREG1A    ; Use REG testing code to complete
  858.  
  859. ;-------------------------
  860.  
  861. ; Subroutine to interpret a comparison operator string
  862. ;
  863. ;    This subroutine reads an operator string of one or two characters.
  864. ;    When called, HL points to the character string; on exit, HL points
  865. ;    to the character following the operator string, register C contains
  866. ;    an effective one-character operator (= or < or >), and the negation
  867. ;    flag has been complemented if the operators were not-equal, greater-
  868. ;    than-or-equal, or less-than-or-equal.  If an invalid operator string
  869. ;    is encountered, the routine displays an error message and returns
  870. ;    a false if state.
  871.  
  872. READOPER:
  873.     LD    A,(HL)        ; Get first operator character
  874.     LD    C,A        ; Save it in C
  875.     INC    HL        ; Point to next character
  876.     CP    '='        ; Equality?
  877.     RET    Z        ; If so, we have complete operator
  878.     CP    '>'        ; Greater than?
  879.     JR    Z,GTOPER    ; If so, jump
  880.     CP    '<'        ; Less than?
  881.     JR    Z,LTOPER    ; If so, jump
  882.  
  883.     CALL    PRINT        ; We must have a bad operator
  884.     DEFB    ' Bad operator',0
  885.     JP    ERRORMSG    ; Return with false if state
  886.  
  887. GEOPER:                ; Treat '>=' as 'not <'
  888.     LD    A,'<'        ; Equivalent negated operator
  889.     JR    SETOPER
  890.  
  891. GTOPER:
  892.     LD    A,(HL)        ; Check for second operator character
  893.     CP    '='        ; Greater than or equal?
  894.     JR    Z,GEOPER
  895.     CP    '<'        ; Not equal "><" ?
  896.     RET    NZ        ; If not, must be end of operator string
  897.                 ; If so, fall through to NEOPER
  898. NEOPER:
  899.     LD    A,'='        ; Equivalent negated operator
  900. SETOPER:
  901.     LD    C,A        ; Save operator in C
  902.     INC    HL        ; Point to character after operator string
  903.     JP    NEGCOMPL    ; Complement negation flag and return
  904.  
  905. LTOPER:
  906.     LD    A,(HL)        ; Check for second operator character
  907.     CP    '='        ; Less than or equal?
  908.     JR    Z,LEOPER
  909.     CP    '>'        ; Not equal?
  910.     JR    Z,NEOPER
  911.     RET            ; We have '<'
  912.  
  913. LEOPER:
  914.     LD    A,'>'        ; Equivalent negated operator
  915.     JR    SETOPER
  916.  
  917.      ENDIF    ; REGVALOPT
  918.  
  919. ;-----------------------------------------------------------------------------
  920.  
  921. ; Condition:  TCAP
  922. ;
  923. ;    This test returns true if any terminal capability descriptor is
  924. ;    loaded into the TCAP buffer.  If the XTCAPOPT equate is true, then
  925. ;    the following extended syntax is supported:
  926. ;
  927. ;            IF TCAP STRING
  928. ;
  929. ;    The name of the loaded terminal will be compared to the string, and
  930. ;    the if state will be set to true only if they match.  The comparison
  931. ;    is made only for the number of characters present in STRING, and
  932. ;    wild cards ('?') are allowed in STRING.
  933.  
  934. IFCTCAP:
  935.     CALL    GETENV        ; Get ptr to ZCPR3 environment descriptor
  936.     LD    DE,80H        ; Pt to TCAP entry
  937.     ADD    HL,DE
  938.     LD    A,(HL)        ; Get first char
  939.     CP    ' '+1        ; Space or less = none
  940.     JR    C,AMBFALSE
  941.  
  942.      IF    XTCAPOPT    ; Extended TCAP condition testing
  943.  
  944.     PUSH    HL        ; Save pointer to TCAP ID
  945.     CALL    SKIP2        ; Make HL point to second command-line token
  946.     POP    DE        ; Get TCAP ID pointer into DE
  947. IFCTCAP1:
  948.     LD    A,(HL)        ; Get character from test string
  949.     OR    A        ; Test for end of line
  950.     JR    Z,WHLTRUE    ; If end of string, ID matches
  951.     CP    '?'        ; If wild card, take it as a match
  952.     JR    Z,IFCTCAP2
  953.     LD    A,(DE)        ; Get character from TCAP ID
  954.     CALL    CAPS        ; Capitalize it
  955.     CP    (HL)        ; Compare to test string
  956.     JR    NZ,AMBFALSE    ; Mismatch found
  957. IFCTCAP2:
  958.     INC    HL        ; Advance pointers
  959.     INC    DE
  960.     JR    IFCTCAP1    ; Loop through string
  961.  
  962.      ELSE    ; NOT XTCAPOPT
  963.  
  964.     JR    WHLTRUE
  965.  
  966.      ENDIF    ; XTCAPOPT
  967.  
  968.  
  969. ;-----------------------------------------------------------------------------
  970.  
  971. ; Condition:  WHEEL
  972. ;
  973. ;    This test returns true if the wheel byte contains a value other
  974. ;    than zero.
  975.  
  976. IFCWHEEL:
  977.     CALL    GETWHL        ; Get current wheel setting
  978.     JR    Z,AMBFALSE
  979. WHLTRUE:            ; Entry point for relative jump
  980.     JP    IFCTRUE
  981.  
  982.  
  983. ;-----------------------------------------------------------------------------
  984.  
  985. ; Condition:  AMBIG
  986. ;
  987. ;    This test returns true if the file specification given as the second
  988. ;    token on the command line is ambiguous (contains '*' or '?').
  989.  
  990. IFCAMBIG:
  991.     LD    HL,FCB2+1    ; Scan FCP2 for '?' characters
  992.     LD    B,11        ; Characters to scan
  993.     LD    A,'?'        ; Target character
  994. AMBIG1:
  995.     CP    (HL)        ; Is character in file name is '?'
  996.     JR    Z,WHLTRUE    ; If so, test is true
  997.     INC    HL        ; Point to next character
  998.     DJNZ    AMBIG1        ; Loop back to test more
  999. AMBFALSE:            ; Entry point for relative jumps
  1000.     JP    IFCFALSE    ; Must not be ambiguous
  1001.  
  1002.  
  1003. ;-----------------------------------------------------------------------------
  1004.  
  1005. ; Condition:  COMPRESSED
  1006.  
  1007.      IF    COMPROPT
  1008.  
  1009. IFCCOMPR:
  1010.     LD    A,(FCB2+10)    ; Get middle character of file type
  1011.     CP    'Z'        ; Crunched
  1012.     JR    Z,WHLTRUE
  1013.     CP    'Q'        ; Squeezed
  1014.     JR    Z,WHLTRUE
  1015.     JR    AMBFALSE
  1016.  
  1017.      ENDIF    ; COMPROPT
  1018.  
  1019. ;-----------------------------------------------------------------------------
  1020.  
  1021. ;  Condition:  LIST
  1022.  
  1023. ;    this test returns true if the following token contains multiple
  1024. ;    items separated by commas.
  1025.  
  1026.      IF    LISTOPT
  1027.  
  1028. LIST:
  1029.     CALL    SKIP2        ; Skip to 2nd token
  1030.  
  1031. LIST1:
  1032.     LD    A,(HL)        ; Get character
  1033.     INC    HL        ; Point to next character
  1034.     CP    ' '+1        ; End of token?
  1035.     JR    C,AMBFALSE    ; Set false if so
  1036.     CP    ','        ; A comma?
  1037.     JR    NZ,LIST1    ; If not, keep looking
  1038.     LD    A,(HL)        ; Get next character
  1039.     CP    ' '+1        ; Something following comma?
  1040.     JR    NC,WHLTRUE    ; If so, we have a list
  1041.     JR    AMBFALSE
  1042.  
  1043.      ENDIF    ; LISTOPT
  1044.  
  1045. ;-----------------------------------------------------------------------------
  1046.  
  1047. ;  Condition:  SHELL
  1048. ;
  1049. ;    This test returns true if anything is on the shell stack.  It returns
  1050. ;    a false condition if there is no shell stack.  If XSHELLOPT equate is
  1051. ;    true, then the following optional syntax is supported:
  1052. ;
  1053. ;            IF SHELL NAME
  1054. ;
  1055. ;    With this form, the code will compare the given NAME with the program
  1056. ;    name on the top of the shell stack.  Any leading DU: or DIR: will be
  1057. ;    skipped, both in NAME and in the shell stack entry.  Wild cards are
  1058. ;    allowed in NAME.
  1059.  
  1060.      IF    SHELLOPT
  1061.  
  1062. IFCSHELL:
  1063.     CALL    GETSH1        ; Get shell stack info
  1064.     JP    Z,IFCFALSE    ; False if no shell stack
  1065.     LD    A,(HL)        ; See if anything on stack
  1066.     OR    A
  1067.     JR    Z,AMBFALSE    ; False if not
  1068.  
  1069.      IF    XSHELLOPT    ; Extended shell option
  1070.  
  1071.     LD    DE,FCB1        ; Parse shell stack entry into FCB1
  1072.     XOR    A        ; Scan DIR: before DU:
  1073.     CALL    ZFNAME
  1074.     CALL    SKIP2        ; Point to second command-line token
  1075.     JP    Z,IFCTRUE    ; If no second token, set state to true
  1076.     LD    DE,FCB2        ; Else parse token into FCB2
  1077.     XOR    A        ; Scan DIR: before DU:
  1078.     CALL    ZFNAME
  1079.     LD    HL,FCB1+9    ; Force match in file types
  1080.     LD    B,3        ; ..by setting type to '???'
  1081. IFCSHELL0:
  1082.     LD    (HL),'?'
  1083.     INC    HL
  1084.     DJNZ    IFCSHELL0
  1085.  
  1086.     LD    HL,FCB1+1    ; Compare name in FCB1 to that in FCB2
  1087.     JP    IFCEQ
  1088.  
  1089.      ENDIF    ; XSHELLOPT
  1090.  
  1091.     JR    WHLTRUE        ; Otherwise true
  1092.  
  1093.      ENDIF    ; SHELLOPT
  1094.  
  1095. ;-----------------------------------------------------------------------------
  1096.  
  1097. ;  Condition:  ZEX
  1098. ;
  1099. ;    This test returns true if ZEX is currently running.  If no message
  1100. ;    buffer is implemented, it returns false.
  1101.  
  1102.      IF    ZEXOPT
  1103.  
  1104. IFCZEX:
  1105.     CALL    GETZRUN        ; See if ZEX running
  1106.     JR    C,AMBFALSE    ; If no message buffer, take as false
  1107.     JR    Z,AMBFALSE    ; If ZEX not running, set false
  1108.     JR    WHLTRUE        ; Otherwise, set true
  1109.  
  1110.      ENDIF    ; ZEXOPT
  1111.  
  1112. ;-----------------------------------------------------------------------------
  1113.  
  1114. ; Condition:  TAG <file list> <n>
  1115.  
  1116. ;    This test returns true if each file in the list exists and if
  1117. ;    byte n, (1 <= n >= 8), of the file's name in the directory has its
  1118. ;    msb set.
  1119.  
  1120.      IF    TAGOPT
  1121.  
  1122. IFCTAG:
  1123.     CALL    SKIP2        ; Skip to second token
  1124.     CALL    SKNSP        ; Skip over it
  1125.     CALL    SKSP        ; ..to third token
  1126.     CALL    GETNUM        ; Get byte to test
  1127.     LD    A,B        ; Byte number in A
  1128.     OR    A
  1129.     JR    Z,TAGERR    ; Error if number more than 255
  1130.     CP    8+1        ; Must not be > 8
  1131.     JR    C,TAG1
  1132.  
  1133. TAGERR:
  1134.     CALL    PRINT
  1135.     DEFB    ' Bad tag',0
  1136.     JP    ERRORMSG
  1137.  
  1138.      ENDIF    ; TAGOPT
  1139.  
  1140.      IF    ATTROPTS
  1141.  
  1142. TAG1:
  1143.     LD    (OFFSET),DE    ; Store offset to tag byte
  1144.     CALL    NEGCOMPL    ; Reverse sense of true/false if negated
  1145.     LD    HL,ATTRTST    ; Get return to call
  1146.     LD    (TSTCALL),HL    ; Modify call instruction
  1147.     JR    IFCEM0        ; Go to modified empty test
  1148.  
  1149. ; Return to test for file attribute set.  On entry, regiter D
  1150. ; points to the FCB.
  1151.  
  1152. ATTRTST:
  1153.     LD    HL,(OFFSET)    ; Get offset into HL
  1154.     ADD    HL,DE        ; Now pointing at desired byte
  1155.     LD    A,(HL)
  1156.     RLCA            ; Get msb into carry
  1157.     JP    NC,IFCTRUE    ; False if not set (sense reversed)
  1158.     RET
  1159.  
  1160.      ENDIF    ; ATTROPTS
  1161.  
  1162. ;-----------------------------------------------------------------------------
  1163.  
  1164. ; Condition:  RO <file list>
  1165.  
  1166. ;    This test returns true if all files in the list are set
  1167. ;    to read-only.
  1168.  
  1169.      IF ROOPT
  1170.  
  1171. IFCRO:
  1172.     LD    DE,9        ; Offset to R/O flag
  1173.     JR    TAG1        ; Go perform function
  1174.  
  1175.      ENDIF    ; ROOPT
  1176.  
  1177. ;-----------------------------------------------------------------------------
  1178.  
  1179. ; Condition:  SYS <file list>
  1180.  
  1181. ;    This test returns true if all files in the list are set
  1182. ;    to system.
  1183.  
  1184.      IF    SYSOPT
  1185.  
  1186. IFCSYS:
  1187.     LD    DE,10        ; Offset to SYS flag
  1188.     JR    TAG1        ; Go perform function
  1189.  
  1190.      ENDIF    ; SYSOPT
  1191.  
  1192. ;-----------------------------------------------------------------------------
  1193.  
  1194. ; Condition:  ARCHIVE <file list>
  1195.  
  1196. ;    This test returns true if all files in the list are set
  1197. ;    to archive.
  1198.  
  1199.      IF    ARCOPT
  1200.  
  1201. IFCARC:
  1202.     LD    DE,11        ; Offset to ARC flag
  1203.     JR    TAG1        ; Go perform function
  1204.  
  1205.      ENDIF    ; ARCOPT
  1206.  
  1207. ;-----------------------------------------------------------------------------
  1208.  
  1209. ; Condition: EXIST <file list>
  1210. ;
  1211. ;    A list of ambiguous file names separated by commas (no spaces allowed)
  1212. ;    may be given.  If at least one file from each ambiguous file
  1213. ;    specification exists, then the if state will be set to true.  As soon
  1214. ;    as one ambiguous file specification fails to match an existing file
  1215. ;    the condition is set to false.
  1216.  
  1217. IFCEXIST:
  1218.     CALL    NEGCOMPL    ; Reverse the sense of testing (vs EM test)
  1219.     LD    HL,JUSTRET    ; Modify call in empty test
  1220.     LD    (TSTCALL),HL
  1221.     JR    IFCEM0        ; Go to modified empty test
  1222.  
  1223.  
  1224. ;-----------------------------------------------------------------------------
  1225.  
  1226. ; Condition: EMPTY filename.typ
  1227. ;
  1228. ;    This test is like a NOT EXIST test except that existence is taken to
  1229. ;    require not only a directory entry for a file but also some contents
  1230. ;    to the file.  If ANY tested filespec is nonexistent or empty, then the
  1231. ;    if state is set to true.  If ALL files do exist and contain data, then
  1232. ;    the state is set to false.
  1233. ;
  1234. ;    The stack is not always cleaned up here, but that is no problem.
  1235.  
  1236. IFCEMPTY:
  1237.     LD    HL,READREC    ; Addr of rtn to execute
  1238.     LD    (TSTCALL),HL    ; Modify call instruction
  1239.  
  1240. IFCEM0:
  1241.     CALL    SKIP2        ; Skip to 2nd token
  1242.     JP    Z,IFCTRUE    ; TRUE if none
  1243.     CALL    PUTUD        ; Store current du
  1244.  
  1245. ; Loop through files in list
  1246.  
  1247. IFCEM1:
  1248.     CP    ':'        ; Check first char of token
  1249.     JR    NZ,IFCEM1A
  1250.     INC    HL        ; Skip over leading colon (confuses zfname)
  1251.  
  1252. IFCEM1A:
  1253.     LD    DE,FCB1        ; Point to FCB1
  1254. XOR    A        ; Set du1st flag
  1255.     CALL    ZFNAME        ; Convert string to filespec
  1256.     PUSH    HL        ; Save pointer to file list string
  1257.     CALL    TLOG        ; Log into FCB1's DU
  1258.     LD    DE,FCB1        ; Try to open file
  1259.     LD    C,15
  1260.     PUSH    DE        ; Save FCB pointer
  1261.     CALL    BDOS
  1262.     POP    DE
  1263.     INC    A        ; Z if not found
  1264.     JR    Z,IFCTRUE    ; If not found, set true if state
  1265.  
  1266. TSTCALL    EQU    $+1        ; Pointer for in-code modification
  1267.     CALL    0        ; Perform function
  1268.  
  1269. IFCEM2:                ; File exists (and has contents if EM test)
  1270.                 ; ... or has specified attribute
  1271.     CALL    GETUD        ; Log back to original du
  1272.     POP    HL        ; Get back pointer to file list
  1273.     LD    A,(HL)        ; Check for additional files on list
  1274.     INC    HL
  1275.     CP    ','        ; More to come?
  1276.     JR    NZ,IFCFALSE    ; All files found, so set state to false
  1277.     LD    A,(HL)        ; Make sure not a terminal comma
  1278.     CP    ' '+1
  1279.     JR    C,IFCFALSE    ; End of list, all empty, so FALSE
  1280.     JR    IFCEM1        ; Process next item
  1281.  
  1282. READREC:
  1283.     LD    C,20        ; Try to read a record
  1284.     CALL    BDOS
  1285.     OR    A        ; Z if files has contents
  1286.     JR    NZ,IFCTRUE    ; If file empty, set true if state
  1287. JUSTRET:
  1288.     RET
  1289.  
  1290. ;-----------------------------------------------------------------------------
  1291.  
  1292. ; Condition: INPUT (from user)
  1293. ;
  1294. ;    If there is any text after the option, it is used as a prompt.  The
  1295. ;    string " (Y/N)? " is automatically appended.  Any of the following
  1296. ;    input from the user is taken as affirmative: CR, space, Y, or T.
  1297. ;    Any other input is taken as a negative answer.
  1298.  
  1299. IFCINPUT:
  1300.     LD    A,CR        ; Carriage return
  1301.     CALL    COUT
  1302.     LD    A,LF        ; New line
  1303.     CALL    COUT
  1304.     CALL    STOPZEX        ; Suspend ZEX input
  1305.     LD    HL,TBUFF+1    ; See if text is given in command tail
  1306.     CALL    SKIP2        ; Skip to second token
  1307.     JR    Z,IFCIN2    ; If end of line, use default 'IF True?'
  1308.  
  1309.     CALL    ECHO        ; Echo the rest of line with case and control
  1310.                 ; ..character interpretation
  1311. ;    CALL    PRINT        ; Append the following
  1312. ;    DEFB    ' (Y/N)? ',0
  1313.     JR    IFCIN3
  1314.  
  1315. IFCIN2:
  1316.     CALL    PRINT
  1317.     DEFB    ' IF True? ',0
  1318.  
  1319. IFCIN3:
  1320.     CALL    CAPINE
  1321.     CALL    STRTZEX        ; Resume ZEX input
  1322.     CP    'T'        ; True?
  1323.     JR    Z,IFCTRUE
  1324.     CP    'Y'        ; Yes?
  1325.     JR    Z,IFCTRUE
  1326.     CP    CR        ; New line?
  1327.     JR    Z,IFCTRUE
  1328.     CP    ' '        ; Space?
  1329.     JR    Z,IFCTRUE
  1330.     JR    IFCFALSE
  1331.  
  1332.  
  1333. ;-----------------------------------------------------------------------------
  1334.  
  1335. ; Condition: ERROR
  1336. ;
  1337. ;    This tests the program error flag.  If it has a value of zero, then
  1338. ;    the if state is set to false.  If the value is nonzero, then an error
  1339. ;    condition is assumed to exist, and the if state is set to true.
  1340. ;    If the equate XERROPT is true, then the following form will also be
  1341. ;    processed:
  1342. ;            IF ERROR VALUE
  1343. ;
  1344. ;    The if state will be set true only if the program error flag has that
  1345. ;    specified value.
  1346.  
  1347. IFCERROR:
  1348.  
  1349.      IF    XERROPT        ; Extended ERROR option
  1350.  
  1351.     CALL    SKIP2        ; Move to second token
  1352.     LD    B,0        ; Default reference value
  1353.     JR    Z,IFCERR1    ; If no second token, use default
  1354.     CALL    NEGCOMPL    ; Complement sense of testing
  1355.     CALL    GETNUM        ; Convert token to number in B
  1356. IFCERR1:
  1357.     CALL    GETER2        ; Get error flag value
  1358.     CP    B
  1359.     JR    NZ,IFCTRUE
  1360.     JR    IFCFALSE
  1361.     
  1362.      ELSE    ; NOT XERROPT
  1363.  
  1364.     CALL    GETER2        ; Get error byte
  1365.     JP    NZ,IFCTRUE
  1366.     JP    IFCFALSE
  1367.  
  1368.      ENDIF    ; XERROPT
  1369.  
  1370.  
  1371. ;-----------------------------------------------------------------------------
  1372.  
  1373. ; Condition:  TRUE
  1374. ;    IFCTRUE  enables an active IF
  1375. ;
  1376. ; Condition:  FALSE
  1377. ;    IFCFALSE enables an inactive IF
  1378.  
  1379. IFCTRUE:
  1380.     LD    A,(NEGFLAG)    ; Check for negation of test
  1381.     OR    A
  1382.     JR    NZ,IFCF        ; Make IF FALSE
  1383. IFCT:
  1384.     CALL    IFT        ; Make IF TRUE
  1385.     JR    NZ,RETURN
  1386.     JR    IFOVFL
  1387.  
  1388. IFCFALSE:
  1389.     LD    A,(NEGFLAG)    ; Check for negation of test
  1390.     OR    A
  1391.     JR    NZ,IFCT        ; Make IF TRUE
  1392. IFCF:
  1393.     CALL    IFF        ; Make IF FALSE
  1394.     JR    NZ,RETURN
  1395.  
  1396. IFOVFL:
  1397.     CALL    PRINT
  1398.     DEFB    BEL
  1399.     DEFB    ' IF Overflow',0
  1400.  
  1401. RETURN:
  1402.     LD    SP,(STACK)    ; Restore system stack
  1403.     RET            ; ..and return to operating system
  1404.  
  1405. ERRORMSG:            ; Return from errors with if state false
  1406.     CALL    PRINT
  1407.     DEFB    BEL,
  1408.     DEFB    ' --- Setting FALSE if State'
  1409.     DEFB    0
  1410.     JR    IFCF
  1411.  
  1412. ;=============================================================================
  1413. ;
  1414. ;        S U P P O R T    R O U T I N E S
  1415. ;
  1416. ;=============================================================================
  1417.  
  1418.  
  1419. ; Save TBUFF and skip to 2nd token
  1420.  
  1421. SKIP2:
  1422.     LD    DE,TBUFF+1    ; Pt to first char
  1423.     LD    HL,ENTRY-80H    ; Use area immediately below us (Type 4)
  1424.     LD    A,(TYPE)
  1425.     CP    4
  1426.     CALL    NZ,CODEND    ; Pt to free area above us (Type 3)
  1427.     PUSH    HL
  1428.  
  1429. SKIP2A:                ; Copy command line tail to buffer area
  1430.     LD    A,(DE)        ; Get next char
  1431.     LD    (HL),A        ; Save it
  1432.     INC    HL        ; Pt to next
  1433.     INC    DE
  1434.     OR    A        ; Done?
  1435.     JR    NZ,SKIP2A
  1436.  
  1437.     POP    HL        ; Point to command line tail again
  1438.     CALL    SKSP        ; Skip over spaces
  1439.     CALL    SKNSP        ; Skip over 1st token
  1440.     CALL    SKSP        ; Skip over spaces
  1441.  
  1442.     LD    A,(HL)        ; Get 1st char of 2nd
  1443.     OR    A        ; Return with Z if none
  1444.     RET
  1445.  
  1446. ;-------------------------
  1447.  
  1448. ; Convert chars pointed to by HL into a byte-length number in B.  Give an error
  1449. ; message if the value is not in byte range.
  1450.  
  1451. GETNUM:
  1452.     CALL    EVAL        ; Evaluate
  1453.     LD    B,E        ; Move low-byte value to B
  1454.     LD    A,D        ; Check high byte for zero
  1455.     OR    A
  1456.     RET    Z        ; Return if no overflow to high byte
  1457.  
  1458. NUMERROR:
  1459.     CALL    PRINT        ; Print error message and return with false
  1460.     DEFB    ' Bad number',0
  1461.     JR    ERRORMSG
  1462.  
  1463. ;-------------------------
  1464.  
  1465. ; Log into DU in FCB1
  1466.  
  1467. TLOG:
  1468.     LD    A,(FCB1)    ; Get disk
  1469.     OR    A        ; Current?
  1470.     JR    NZ,TLOG1
  1471.     LD    C,25        ; Get disk
  1472.     CALL    BDOS
  1473.     INC    A        ; Increment for following decrement
  1474. TLOG1:
  1475.     DEC    A        ; A=0
  1476.     LD    E,A        ; Disk in E
  1477.     LD    C,14
  1478.     CALL    BDOS
  1479.     LD    A,(FCB1+13)    ; Pt to user
  1480.     LD    E,A
  1481.     LD    C,32        ; Set user
  1482.     JP    BDOS
  1483.  
  1484. ;-------------------------
  1485.  
  1486. ; Try to evaluate the first token in the tail as a register number.  There
  1487. ; are some complications as a result of allowing nondecimal numbers.  We
  1488. ; check for condition 'EX' separately, and we also require that the entire
  1489. ; token be a number (no extra characters).  Otherwise EVAL can return a
  1490. ; zero value for miscellaneous strings.
  1491.  
  1492. REGTEST:
  1493.     LD    H,D        ; Move DE into HL for EVAL
  1494.     LD    L,E
  1495.     LD    A,(DE)        ; Check for special case of 'EX'
  1496.     CP    'E'        ; ..which can be mistaken for
  1497.     JR    NZ,REGTEST1    ; ..a hex number 0EH
  1498.     INC    DE
  1499.     LD    A,(DE)
  1500.     CP    'X'
  1501.     RET    Z        ; If we have 'EX' condition, return
  1502.  
  1503. REGTEST1:
  1504.     CALL    EVAL        ; Try to evaluate a number
  1505.     RET    C        ; Carry flag set if bad number
  1506.  
  1507.     LD    A,(HL)        ; If we are not at end of token
  1508.     CP    ' '+1        ; ..then we do not have a number
  1509.     RET    NC
  1510.  
  1511.     LD    A,E        ; Get low byte of number
  1512.     CP    10        ; If low byte >=10
  1513.     JR    NC,REGERROR    ; ..then it's out of range
  1514.  
  1515.     LD    A,D        ; Get high byte of number
  1516.     OR    A        ; If high byte  >0,
  1517.     JR    NZ,REGERROR    ; ..then it's out of range
  1518.  
  1519.     LD    B,E        ; Get register number into B
  1520.     CALL    GETREG        ; Get value of register into A
  1521.     PUSH    AF        ; Save value
  1522.     CALL    SKIP2        ; Point to second command line token
  1523.     CALL    GETNUM        ; Convert it to a number
  1524.     POP    AF        ; Get value
  1525.     CP    B        ; Compare against extracted value
  1526.     JP    Z,IFCTRUE    ; TRUE if match
  1527.     JP    IFCFALSE    ; FALSE if non-match
  1528.  
  1529. REGERROR:
  1530.     CALL    PRINT
  1531.     DEFB    ' Bad register number'
  1532.     DEFB    0
  1533.     JP    ERRORMSG    ; Return with false if
  1534.  
  1535. ;-------------------------
  1536.  
  1537. ; Test FCB1 against condition table (must have 2-char entries)
  1538. ;  Return with routine address in HL if match and NZ flag
  1539.  
  1540. CONDTEST:
  1541.     LD    HL,CONDTAB    ; Point to condition table
  1542. CONDT0:
  1543.     LD    A,(HL)        ; End of table?
  1544.     OR    A
  1545.     RET    Z
  1546.     LD    A,(DE)        ; Get first char of specified condition
  1547.     LD    B,(HL)        ; Get first char of table option into B
  1548.     INC    HL        ; Point to next characters
  1549.     INC    DE
  1550.     CP    B        ; Compare entries
  1551.     JR    NZ,CONDT2    ; Branch on mismatch
  1552.     LD    A,(DE)        ; Get 2nd char of given option
  1553.     OR    A        ; If not null
  1554.     JR    NZ,CONDT1    ; ..jump on
  1555.     LD    A,' '        ; Otherwise substitute a space
  1556. CONDT1:
  1557.     CP    (HL)        ; Compare
  1558.     JR    NZ,CONDT2
  1559.     INC    HL        ; Pt to address
  1560.     LD    A,(HL)        ; Get address in HL
  1561.     INC    HL
  1562.     LD    H,(HL)
  1563.     LD    L,A        ; HL = address
  1564.     XOR    A        ; Set NZ for OK
  1565.     DEC    A
  1566.     RET
  1567. CONDT2:
  1568.     LD    BC,3        ; Pt to next entry
  1569.     ADD    HL,BC        ; ... 1 byte for text + 2 bytes for address
  1570.     DEC    DE        ; Pt to 1st char of condition
  1571.     JR    CONDT0
  1572.  
  1573. ;-------------------------
  1574.  
  1575. ; This routine moves ARG1 into FCB1 and parses the third command line token
  1576. ; into FCB2.  On exit, HL is pointing to the name in FCB1.
  1577.  
  1578.      IF    XCOMP
  1579.  
  1580. SETCOMPARE:
  1581.     LD    HL,FCB2+1    ; Move name in FCB2 to FCB1
  1582.     LD    DE,FCB1+1
  1583.     LD    BC,11
  1584.     LDIR
  1585.     CALL    SKIP2        ; Find third token in command tail
  1586.     CALL    SKNSP        ; ..skip over second token
  1587.     CALL    SKSP        ; ..skip to beginning of third token
  1588.     LD    DE,FCB2        ; Parse token into FCB2
  1589.     XOR    A        ; ..using DIR form before DU
  1590.     CALL    ZFNAME
  1591.     LD    HL,FCB1+1    ; Compare first FCB to second
  1592.     RET
  1593.  
  1594.      ENDIF    ; XCOMP
  1595.  
  1596. ;-------------------------
  1597.  
  1598. ; FCB Comparison Subroutine
  1599. ;
  1600. ;    Returns with:
  1601. ;        Z     if FCBs are the same (wild cards are
  1602. ;            treated as equality)
  1603. ;        NZ    if FCBs are different
  1604. ;        C & NZ    if FCB1 is greater than FCB2
  1605. ;        NC & NZ    if FCB2 is greater than FCB1
  1606.  
  1607. COMPARE:
  1608.     LD    DE,FCB2+1
  1609.     LD    B,11        ; 11 chars
  1610. COMPARE1:
  1611.     LD    A,(DE)        ; Compare
  1612.     CP    '?'        ; See if an AFN was specified
  1613.     JR    Z,COMPARE2    ; Always match a ?
  1614.     LD    C,A        ; Save it in C temporarily
  1615.     LD    A,(HL)        ; Get the other character
  1616.     CP    '?'        ; See if it is a ?
  1617.     JR    Z,COMPARE2    ; If so accept it as a match
  1618.     CP    C
  1619.     RET    NZ        ; Return nonzero if no match
  1620. COMPARE2:
  1621.     INC    HL        ; Advance
  1622.     INC    DE
  1623.     DJNZ    COMPARE1    ; Count down
  1624.     RET            ; Return zero if match
  1625.  
  1626. ;-------------------------
  1627.  
  1628. ; This routine complements the negation flag to reverse the sense of testing.
  1629.  
  1630. NEGCOMPL:
  1631.     LD    A,(NEGFLAG)    ; Get current flag
  1632.     CPL            ; Complement it
  1633.     LD    (NEGFLAG),A    ; Save new value
  1634.     RET
  1635.     
  1636. ;--------------------------
  1637.  
  1638. ; This subroutine echoes the null-terminated string pointed to by HL to the
  1639. ; console.  The special symbol '^' in the string converts the following
  1640. ; character to a control character.  The special symbol '%' flags a special
  1641. ; function.  If followed by '<', output switches to upper case; if followed by
  1642. ; '>', output switches to lower case.  Other characters following the '%' are
  1643. ; echoed as is.
  1644.  
  1645. ECHO:
  1646.     XOR    A        ; Lower case flag setting
  1647.  
  1648.      IF    UPCASE        ; If upper case default
  1649.     DEC    A
  1650.      ENDIF
  1651.  
  1652.     LD    (CASEFL),A    ; Store flag in code below
  1653.  
  1654. ECHO1:
  1655.     CALL    GETCHAR        ; Get next character (returns if end of string)
  1656.     CP    '^'        ; Control character leadin?
  1657.     JR    NZ,ECHO2    ; Branch if not
  1658.  
  1659.     CALL    GETCHAR        ; Get next character
  1660.     AND    1FH        ; Convert to control character
  1661.     JR    ECHO4        ; Echo it
  1662.  
  1663. ECHO2:
  1664.     CP    '%'        ; Case shift prefix?
  1665.     JR    NZ,ECHO4    ; Branch if not
  1666.  
  1667.     CALL    GETCHAR        ; Get next character
  1668.     CP    UCASECH        ; Up-shift character?
  1669.     JR    Z,ECHO3        ; Store non-zero value in case flag
  1670.  
  1671.     CP    LCASECH        ; Lower-case character?
  1672.     JR    NZ,ECHO4    ; If not, echo the character as is
  1673.  
  1674.     XOR    A        ; Else, clear case flag
  1675. ECHO3:
  1676.     LD    (CASEFL),A
  1677.     JR    ECHO1        ; On to next character
  1678.  
  1679. ECHO4:
  1680.     LD    C,A        ; Save real character in C
  1681.     CP    'A'        ; Branch to ECHO5 if not in range A..Z
  1682.     JR    C,ECHO5
  1683.     CP    'Z'+1
  1684.     JR    NC,ECHO5
  1685.     ADD    A,20H        ; Make a lower case version
  1686. ECHO5:
  1687.     LD    D,A        ; Save lower case version in D
  1688. CASEFL    EQU    $+1        ; Pointer for in-the-code modification
  1689.     LD    A,0
  1690.     OR    A        ; Clear Z flag if upper case
  1691.     LD    A,C        ; Get upper case version of character
  1692.     JR    NZ,ECHO6    ; If upper case selected, go on as is
  1693.     LD    A,D        ; Else substitute lower case version
  1694. ECHO6:
  1695.     CALL    COUT        ; Output the character and return
  1696.     JR    ECHO1        ; Back to process next character
  1697.  
  1698. GETCHAR:
  1699.     LD    A,(HL)        ; Get character
  1700.     INC    HL        ; Point to next one
  1701.     OR    A        ; Check for end of string
  1702.     RET    NZ        ; If not end, return to caller
  1703.     POP    HL        ; Else, clean up stack
  1704.     RET            ; ..and exit from main routine
  1705.  
  1706. ;=============================================================================
  1707.  
  1708. ; Buffers
  1709.  
  1710.      IF    USEDSEG
  1711.     DSEG
  1712.      ENDIF    ; USEDSEG
  1713.  
  1714.      IF ATTROPTS
  1715. OFFSET:
  1716.     DEFS    2        ; Storage for attribute offset
  1717.      ENDIF            ; Attropts
  1718.  
  1719. NEGFLAG:
  1720.     DEFS    1        ; Negation flag
  1721.  
  1722.     DEFS    2*25        ; Space for local stack
  1723. STACK:    DEFS    2        ; Place to save system stack
  1724.  
  1725.     END
  1726.