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 / ZSYS / SIMTEL20 / ZCPR3 / IF.MQC / IF.MAC
Text File  |  2000-06-30  |  10KB  |  542 lines
  1. ;
  2. ; Program: IF
  3. ; Author: Richard Conn
  4. ; Modified By: Charles McManis
  5. ; Version: 1.2
  6. ; Date: 11 Feb 85
  7. ; Previous Versions:  1.1 (22 Apr 84)
  8. ;
  9. version    equ    12
  10.  
  11. ;
  12. ;    IF is intended to be invoked from the IF routine in an FCP.
  13. ; This program implements the IF conditional tests and sets the next level
  14. ; of IF to be TRUE or FALSE.
  15. ; 
  16. ; Modified on 02/11/85 to accept ambiguous file names and match them. This 
  17. ; allows aliases to add file extensions if they are needed, for instance 
  18. ; if there is an alias LDIR that gets a directory of an .LBR file, it 
  19. ; previously had to be defined as an example :
  20. ; 
  21. ;
  22.  
  23. ;
  24. ; Equates for Key Values
  25. ;
  26. z3env    SET    0f400h    ;address of ZCPR3 environment
  27. noise    equ    0    ;set to 1 for noisey (message) operation
  28. negchar    equ    '~'    ;negation prefix char
  29. bdos    equ    5
  30. fcb1    equ    5ch
  31. fcb2    equ    6ch
  32. tbuff    equ    80h
  33. cr    equ    0dh
  34. lf    equ    0ah
  35. bel    equ    07h
  36.  
  37. ;
  38. ; External Z3LIB and SYSLIB Routines
  39. ;
  40.     ext    z3init,strtzex,stopzex,geter1,getreg,ift,iff,getenv
  41.     ext    eval10,print,capine,codend,sksp,sknsp,zfname,cout
  42.  
  43. ;
  44. ; Environment Definition
  45. ;
  46.     if    z3env ne 0
  47. ;
  48. ; External ZCPR3 Environment Descriptor
  49. ;
  50.     jmp    start
  51.     db    'Z3ENV'    ;This is a ZCPR3 Utility
  52.     db    1    ;External Environment Descriptor
  53. z3eadr:
  54.     dw    z3env
  55. start:
  56.     lhld    z3eadr    ;pt to ZCPR3 environment
  57. ;
  58.     else
  59. ;
  60. ; Internal ZCPR3 Environment Descriptor
  61. ;
  62.     MACLIB    Z3BASE.LIB
  63.     MACLIB    SYSENV.LIB
  64. z3eadr:
  65.     jmp    start
  66.     SYSENV
  67. start:
  68.     lxi    h,z3eadr    ;pt to ZCPR3 environment
  69.     endif
  70.  
  71. ;
  72. ; Start of Program -- Initialize ZCPR3 Environment
  73. ;
  74.     call    z3init    ;initialize the ZCPR3 Environment
  75.     jmp    ifstart
  76. ;
  77. ; Condition Table
  78. ;
  79. condtab:
  80.     db    'T '        ;TRUE
  81.     dw    ifctrue
  82.     db    'F '        ;FALSE
  83.     dw    ifcfalse
  84.     db    'EM'        ;file empty
  85.     dw    ifcempty
  86.     db    'ER'        ;error message
  87.     dw    ifcerror
  88.     db    'EX'        ;file exists
  89.     dw    ifcex
  90.     db    'IN'        ;user input
  91.     dw    ifcinput
  92.     db    'NU'        ;null argument
  93.     dw    ifcnull
  94.     db    'TC'        ;Z3TCAP Entry Loaded
  95.     dw    ifctcap
  96.     db    'WH'        ;Wheel Byte
  97.     dw    ifcwheel
  98.     db    0
  99.  
  100. ;
  101. ; FCP Extension Command: IF
  102. ;
  103. ifstart:
  104. ;
  105. ; Advance to Next Line if Noisey
  106. ;
  107.     IF    NOISE
  108.     mvi    a,lf
  109.     call    cout
  110.     ENDIF        ;NOISE
  111. ;
  112. ; Test for Equal Sign in Line and Process FCB1=FCB2 form if so
  113. ;
  114.     lxi    h,tbuff+1    ;pt to buffer
  115. ifteq:
  116.     mov    a,m        ;look for =
  117.     inx    h        ;pt to next
  118.     ora    a        ;done if EOL
  119.     jz    ifck0
  120.     cpi    '='        ;equal?
  121.     jnz    ifteq
  122.     lxi    h,fcb1+1    ;= found, so compare FCB1 and FCB2
  123.     lxi    d,fcb2+1
  124.     mvi    b,11        ;11 chars
  125. ifteq1:
  126.     ldax    d        ;compare
  127. ; ** Such a small change really.
  128.     cpi    '?'        ; see if an AFN was specified
  129.     jz    okchar        ; always match a ?
  130.     mov    c,a        ; save it in C temporarily
  131.     mov    a,m        ; get the other character
  132.     cpi    '?'        ; see if it is a ?
  133.     jz    okchar        ; if so accept it as a match
  134.     cmp    c
  135. ; ** This allows IF $1=* and IF $1=*.?q? etc
  136. ;    cmp    m        ; this guy is no longer needed.
  137.     jnz    ifcf        ;FALSE if no match
  138. okchar:
  139.     inx    h        ;advance
  140.     inx    d
  141.     dcr    b        ;count down
  142.     jnz    ifteq1
  143.     jmp    ifct        ;TRUE if match
  144. ;
  145. ; Test Condition in FCB1 and file name in FCB2
  146. ;   Execute condition processing routine
  147. ;
  148. ifck0:
  149.     lxi    d,fcb1+1    ;pt to first char in FCB1
  150.     ldax    d        ;get it
  151.     cpi    '/'        ;help?
  152.     jz    ifhelp
  153.     cpi    ' '        ;also help
  154.     jz    ifhelp
  155.     sta    negflag        ;set negate flag
  156.     cpi    negchar        ;is it a negate?
  157.     jnz    ifck1
  158.     inx    d        ;pt to char after negchar
  159. ifck1:
  160.     call    regtest        ;test for register value
  161.     jnz    runreg
  162.     call    condtest    ;test of condition match
  163.     jnz    runcond        ;process condition
  164.     IF    NOISE
  165.     call    print
  166.     db    ' No IF Condition Given',0
  167.     ret
  168.     ELSE        ;NOT NOISE
  169.     mvi    a,bel
  170.     jmp    cout
  171.     ENDIF        ;NOISE
  172. ;
  173. ; Print Help Message
  174. ;
  175. ifhelp:
  176.     IF    NOT NOISE
  177.     mvi    a,lf    ;leading new line
  178.     call    cout
  179.     ENDIF        ;NOT NOISE
  180.     call    print
  181.     db    'IF, Version '
  182.     db    (version/10)+'0','.',(version mod 10)+'0'
  183.     db    ' - Conditional Test'
  184.     db    cr,lf,'Syntax:'
  185.     db    cr,lf,'    IF condition arguments -or- IF ~condition arguments'
  186.     db    cr,lf,'where a leading "~" negates the effect of the '
  187.     db    'IF Condition'
  188.     db    cr,lf,'Possible IF Conditions are:'
  189.     db    cr,lf,'    T            Always TRUE'
  190.     db    cr,lf,'    F            Always FALSE'
  191.     db    cr,lf,'    EMPTY <file list>    T if Files are Empty'
  192.     db    cr,lf,'    ERROR            T if Error Flag Set'
  193.     db    cr,lf,'    EXIST <file list>    T if Files Exist'
  194.     db    cr,lf,'    INPUT            T if User Hits T, Y, CR, or SP'
  195.     db    cr,lf,'    NULL arg        T if No Arg Follows'
  196.     db    cr,lf,'    TCAP            T if ZCPR3 TCAP Available'
  197.     db    cr,lf,'    WHEEL            T if Wheel Byte Set'
  198.     db    cr,lf,'    reg value        T if Register reg = value'
  199.     db    cr,lf,'    fcb1=fcb2        T if the Two FCB values are ='
  200.     db    cr,lf,'Only first 2 letters of keywords are required'
  201.     db    cr,lf,'The leading "~" is effective with all conditions except'
  202.     db    ' fcb1=fcb2'
  203.     db    0
  204.     ret
  205. ;
  206. ; Process register - register value is in A
  207. ;
  208. runreg:
  209.     push    psw        ;save value
  210.     call    getnum        ;extract value in FCB2 as a number
  211.     pop    psw        ;get value
  212.     cmp    b        ;compare against extracted value
  213.     jz    ifctrue        ;TRUE if match
  214.     jmp    ifcfalse    ;FALSE if non-match
  215. ;
  216. ; Process conditional test - address of conditional routine is in HL
  217. ;
  218. runcond:
  219.     pchl            ;"call" routine pted to by HL
  220.  
  221. ;
  222. ; Condition:  NULL (2nd file name)
  223. ;
  224. ifcnull:
  225.     lda    fcb2+1        ;get first char of 2nd file name
  226.     cpi    ' '        ;space = null
  227.     jz    ifctrue
  228.     jmp    ifcfalse
  229.  
  230. ;
  231. ; Condition:  TCAP
  232. ;
  233. ifctcap:
  234.     call    getenv        ;get ptr to ZCPR3 environment descriptor
  235.     lxi    d,80h        ;pt to TCAP entry
  236.     dad    d
  237.     mov    a,m        ;get first char
  238.     cpi    ' '+1        ;space or less = none
  239.     jc    ifcfalse
  240.     jmp    ifctrue
  241.  
  242. ;
  243. ; Condition:  WHEEL
  244. ;
  245. ifcwheel:
  246.     call    getenv        ;get ptr to ZCPR3 environment descriptor
  247.     lxi    d,29h        ;pt to Wheel Byte address
  248.     dad    d
  249.     mov    a,m        ;get low
  250.     inx    h
  251.     mov    h,m        ;get high
  252.     mov    l,a        ;put low
  253.     mov    a,m        ;get Wheel Byte
  254.     ora    a        ;0=not wheel
  255.     jz    ifcfalse
  256.     jmp    ifctrue
  257.  
  258. ;
  259. ; Condition:  TRUE
  260. ;    IFCTRUE  enables an active IF
  261. ; Condition:  FALSE
  262. ;    IFCFALSE enables an inactive IF
  263. ;
  264. ifctrue:
  265.     call    negtest    ;test for negate
  266.     jz    ifcf    ;make IF FALSE
  267. ifct:
  268.     IF    NOISE
  269.     call    print
  270.     db    ' IF T',0
  271.     ENDIF        ;NOISE
  272.     call    ift    ;make IF TRUE
  273.     rnz
  274.     jmp    ifovfl
  275. ifcfalse:
  276.     call    negtest    ;test for negate
  277.     jz    ifct    ;make IF TRUE
  278. ifcf:
  279.     IF    NOISE
  280.     call    print
  281.     db    ' IF F',0
  282.     ENDIF        ;NOISE
  283.     call    iff    ;make IF FALSE
  284.     rnz
  285. ifovfl:
  286.     IF    NOISE
  287.     call    print
  288.     db    ' IF Overflow',0
  289.     ret
  290.     ELSE        ;NOT NOISE
  291.     mvi    a,bel
  292.     jmp    cout
  293.     ENDIF        ;NOISE
  294.  
  295. ;
  296. ; Condition: INPUT (from user)
  297. ;
  298. ifcinput:
  299.     IF    NOT NOISE
  300.     mvi    a,lf        ;new line
  301.     call    cout
  302.     ENDIF        ;NOT NOISE
  303.     call    stopzex        ;suspend ZEX input
  304.     call    print
  305.     db    ' IF True? ',0
  306.     call    capine
  307.     call    strtzex        ;resume ZEX input
  308.     cpi    'T'        ;true?
  309.     jz    ifctrue
  310.     cpi    'Y'        ;yes?
  311.     jz    ifctrue
  312.     cpi    cr        ;new line?
  313.     jz    ifctrue
  314.     cpi    ' '        ;space?
  315.     jz    ifctrue
  316.     jmp    ifcfalse
  317.  
  318. ;
  319. ; Condition: EXIST filename.typ
  320. ;    List of Files Permitted
  321. ;
  322. ifcex:
  323.     call    skip2    ;skip to 2nd token
  324.     jz    ifctrue    ;declare TRUE if none
  325. ;
  326. ; Extract Next File
  327. ;
  328. ifcex1:
  329.     lxi    d,fcb1    ;pt to FCB
  330.     call    zfname    ;convert text
  331.     push    h    ;save ptr to next char
  332. ;
  333. ; Log Into to DU and Search for File
  334. ;
  335.     call    tlog    ;log into DU
  336.     lxi    d,fcb1    ;pt to fcb
  337.     mvi    c,17    ;search for first
  338.     call    bdos
  339.     inr    a    ;set zero if error
  340. ;
  341. ; Abort as FALSE if File Not Found
  342. ;
  343.     pop    h    ;get ptr to next char
  344.     jz    ifcfalse
  345. ;
  346. ; Advance to Next File, if Any
  347. ;
  348.     mov    a,m    ;more to follow?
  349.     inx    h
  350.     cpi    ','
  351.     jz    ifcex1
  352. ;
  353. ; All Files Exist if No More Files
  354. ;
  355.     jmp    ifctrue    ;all found, so TRUE
  356.  
  357. ;
  358. ; Condition: EMPTY filename.typ
  359. ;
  360. ifcempty:
  361.     call    skip2    ;skip to 2nd token
  362.     jz    ifctrue    ;TRUE if none
  363. ;
  364. ; Select Next File
  365. ;
  366. ifcem1:
  367.     lxi    d,fcb1    ;pt to FCB1
  368.     call    zfname    ;convert
  369.     push    h    ;save ptr to next
  370. ;
  371. ; Log into DU and Try to Open File
  372. ;
  373.     call    tlog        ;log into FCB1's DU
  374.     lxi    d,fcb1        ;pt to fcb1
  375.     mvi    c,15        ;open file
  376.     push    d        ;save fcb ptr
  377.     call    bdos
  378.     pop    d
  379.     inr    a        ;not found?
  380. ;
  381. ; File is Empty if Not Found
  382. ;
  383.     jz    ifemt
  384. ;
  385. ; Try to Read one Record from File
  386. ;
  387.     mvi    c,20        ;try to read a record
  388.     call    bdos
  389.     ora    a        ;0=OK
  390. ;
  391. ; File is Empty if Can't Read Record
  392. ;
  393.     jnz    ifemt        ;NZ if no read
  394.     pop    h        ;file not empty
  395. ;
  396. ; File Exists and Contains Something
  397. ;
  398.     jmp    ifcfalse    ;so EMPTY condition is FALSE
  399. ;
  400. ; File is Empty - Advance
  401. ;
  402. ifemt:
  403.     pop    h        ;pt to next char
  404.     mov    a,m        ;get next char
  405.     inx    h
  406.     cpi    ','        ;more to come?
  407.     jz    ifcem1
  408. ;
  409. ; Done and True if No More Files - All are Empty
  410. ;
  411.     jmp    ifctrue        ;all empty, so TRUE
  412.  
  413. ;
  414. ; Condition: ERROR
  415. ;
  416. ifcerror:
  417.     call    geter1        ;get error byte
  418.     jz    ifctrue
  419.     jmp    ifcfalse
  420.  
  421. ;
  422. ; **** Support Routines ****
  423. ;
  424.  
  425. ;
  426. ; Save TBUFF and skip to 2nd token
  427. ;
  428. skip2:
  429.     lxi    d,tbuff+1    ;pt to first char
  430.     call    codend        ;pt to free area
  431. skip2a:
  432.     ldax    d        ;get next char
  433.     mov    d
  434.     ora    a        ;done?
  435.     jnz    skip2a
  436.     call    codend        ;skip over spaces
  437.     call    sksp
  438.     call    sknsp        ;skip over 1st token
  439.     call    sksp        ;skip over spaces
  440.     mov    a,m        ;get 1st char of 2nd token
  441.     ora    a        ;return with Z if none
  442.     ret
  443.  
  444. ;
  445. ; Convert chars in FCB2 into a number in B
  446. ;
  447. getnum:
  448.     lxi    h,fcb2+1    ;pt to first char
  449.     call    eval10    ;evaluate
  450.     mov    b,a    ;value in B
  451.     ret
  452.  
  453. ;
  454. ; Log into DU in FCB1
  455. ;
  456. tlog:
  457.     lda    fcb1    ;get disk
  458.     ora    a    ;current?
  459.     jnz    tlog1
  460.     mvi    c,25    ;get disk
  461.     call    bdos
  462.     inr    a    ;increment for following decrement
  463. tlog1:
  464.     dcr    a    ;A=0
  465.     mov    e,a    ;disk in E
  466.     mvi    c,14
  467.     call    bdos
  468.     lda    fcb1+13    ;pt to user
  469.     mov    e,a
  470.     mvi    c,32    ;set user
  471.     jmp    bdos
  472.  
  473. ;
  474. ; Test of Negate Flag = negchar
  475. ;
  476. negtest:
  477.     lda    negflag        ;get flag
  478.     cpi    negchar        ;test for No
  479.     ret
  480.  
  481. ;
  482. ; Test FCB1 against a single digit (0-9)
  483. ;  Return with register value in A and NZ if so
  484. ;
  485. regtest:
  486.     ldax    d        ;get digit
  487.     sui    '0'
  488.     jc    zret        ;Z flag for no digit
  489.     cpi    10        ;range?
  490.     jnc    zret        ;Z flag for no digit
  491.     mov    b,a        ;register number in B
  492.     call    getreg        ;get register value
  493.     mov    b,a        ;save value
  494.     xra    a        ;set NZ
  495.     dcr    a
  496.     mov    a,b        ;get register value
  497.     ret
  498. zret:
  499.     xra    a        ;set Z
  500.     ret
  501.  
  502. ;
  503. ; Test FCB1 against condition table (must have 2-char entries)
  504. ;  Return with routine address in HL if match and NZ flag
  505. ;
  506. condtest:
  507.     lxi    h,condtab    ;pt to table
  508. condt1:
  509.     mov    a,m        ;end of table?
  510.     ora    a
  511.     rz
  512.     ldax    d        ;get char
  513.     mov    b,m        ;get other char in B
  514.     inx    h        ;pt to next
  515.     inx    d
  516.     cmp    b        ;compare entries
  517.     jnz    condt2
  518.     ldax    d        ;get 2nd char
  519.     cmp    m        ;compare
  520.     jnz    condt2
  521.     inx    h        ;pt to address
  522.     mov    a,m        ;get address in HL
  523.     inx    h
  524.     mov    h,m
  525.     mov    l,a        ;HL = address
  526.     xra    a        ;set NZ for OK
  527.     dcr    a
  528.     ret
  529. condt2:
  530.     lxi    b,3        ;pt to next entry
  531.     dad    b        ; ... 1 byte for text + 2 bytes for address
  532.     dcx    d        ;pt to 1st char of condition
  533.     jmp    condt1
  534.  
  535. ;
  536. ; Buffers
  537. ;
  538. negflag:
  539.     ds    1        ;negation flag
  540.  
  541.     end
  542.