home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / submit / ifskip21.lbr / IF.MQC / IF.MAC
Text File  |  1986-12-14  |  10KB  |  467 lines
  1.  title '//IF.ASM Conditional Processor for Submit'
  2. ;
  3. ; by Gary Novasielski. ver 1.0
  4. ;
  5. ; 2.1    (86/10/16) $$$.SUB file always on A0:, for CCP+ 2.1 up
  6. ; 2.0    (85/10/20) handles lower case command lines (as can be
  7. ;     supplied by CCPLUS).    C.B. Falconer.
  8. ;
  9. version    equ    21
  10. ;
  11. @msg    set    9
  12. @ver    set    12
  13. @opn    set    15
  14. @cls    set    16
  15. @del    set    19
  16. @frd    set    20
  17. @cur    set    25
  18. @dma    set    26
  19. @usr    set    32
  20. @siz    set    35
  21. query    equ    0ffh;        CPM enquiry argument
  22. ;
  23. cpmbase    equ    0
  24. boot    set    cpmbase
  25. bdos    set    boot+5
  26. tfcb    equ    boot+5ch
  27. tfcb1    equ    tfcb
  28. tfcb2    equ    tfcb+16
  29. tbuff    equ    boot+80h
  30. tpa    equ    boot+100h
  31. ctrl    equ    ' '-1;        Ctrl char mask
  32. cr    set    ctrl and 'M'
  33. lf    set    ctrl and 'J'
  34. tab    set    ctrl and 'I'
  35. false    set    0
  36. true    set    not false
  37. ;
  38. cpm    macro    func,operand
  39.     if    not nul operand
  40.      lxi    d,operand
  41.     endif;;        of not nul operand
  42.     if    not nul func
  43.      mvi    c,@&func
  44.     endif
  45.     call    bdos
  46.     endm
  47. ;
  48. fcbs2    equ    14
  49. fcbrc    equ    15
  50. fcbr0    equ    33;    Offsets into File Control Blocks
  51. fcbr1    equ    34
  52. fcbr2    equ    35
  53. ;
  54. ;--------------------------------------------------------------
  55.     org    tpa
  56. ;
  57. ifprog:    jmp    pastc
  58.     db    ' V', version/10+'0', '.', version mod 10+'0'
  59.     db    ' Copyright (c) 1982 Gary P. Novosielski '
  60.     db    ctrl and 'Z'
  61. ;
  62. pastc:    lxi    h,0;        Clear HL
  63.     dad    sp;        Get stack pointer value
  64.     lxi    sp,lclstak;    Set local stack
  65.     push    h;        Save old SP on new stack.
  66.     mvi    a,query
  67.     call    sgusr
  68.     sta    user;        save entry user #
  69. ;    "    "
  70. ; Scan the command buffer to find the option list
  71. ; which is defined as everything following the last
  72. ; colon on the line which is preceded by a space.
  73.     lxi    h,tbuff;    Point to command buffer
  74.     mov    a,m;        Get the count byte
  75.     inr    a;        Character after the last...
  76.     mov    c,a;        (save in c)
  77.     add    l;        ...use as index into buffer
  78.     mov    l,a
  79.     adc    h
  80.     sub    l
  81.     mov    h,a
  82. ;    "    "
  83.     mvi    m,0;        Insist on 0 terminator.
  84. ;    "    "         It's there already, but
  85. ;    "    "         not documented.
  86. ; Check for option list.
  87. srchop:    dcr    c;        Out of characters?
  88.     jz    nolist;        No option list found.
  89.     dcx    h;        Next previous character.
  90.     mov    a,m;        To accumulator
  91.     call    upshft;        ensure upper case
  92.     cpi    ':';        Is it a colon?
  93.     cz    srch1;        If yes, check preceding space.
  94.     jz    fndops;        Ok, found the option list.
  95.     jmp    srchop;        option list not found yet
  96. ;
  97. nolist:    mvi    a,true
  98.     sta    optn;        Treat as an option
  99.     jmp    finscn
  100. ;
  101. ; Check for preceding space.
  102. srch1:    mov    a,c;        Index to register A
  103.     sui    2;        At position 2 or better?
  104.     rc;            Leading colon? Very strange.
  105.     dcx    h;        Point to preceding character
  106.     mov    a,m;        Get it
  107.     inx    h;        Point back to colon
  108.     call    upshft;        ensure upshifted
  109.     cpi    ' ';        Was it a space?
  110.     ret;            Return the flags
  111. ;
  112. ;
  113. ; The option list has been located.
  114. ; Scan off the options and set bytes accordingly
  115. fndops:
  116. scnops:    inx    h;        Point to next option char
  117.     mov    a,m;        Move it to A
  118.     call    upshft;        ensure upshifted
  119.     ora    a;        if it's a zero...
  120.     jz    finscn;        there are no more
  121. ;    "    "
  122. ; Check and set valid options
  123.     cpi    'A';        Try first possibility
  124.     jnz    nota;        Nope
  125.     sta    opta;        Yes, set option flag
  126.     jmp    scnops;        Do remaining options.
  127. ;
  128. nota:    cpi    'C';        Try next possibility
  129.     jnz    notc;        Nope
  130.     sta    optc;        Yes, set option flag
  131.     jmp    scnops;        Do remaining options.
  132. ;
  133. notc:    cpi    'D';        Try next possibility
  134.     jnz    notd;        Etc.
  135.     sta    optd
  136.     jmp    scnops
  137. ;
  138. notd:    cpi    'E'
  139.     jnz    note
  140.     sta    opte
  141.     jmp    scnops
  142. ;
  143. note:    cpi    'M'
  144.     jnz    notm
  145.     sta    optm
  146.     jmp    scnops
  147. ;
  148. notm:    cpi    'P'
  149.     jnz    notp
  150.     sta    optp
  151.     jmp    scnops
  152. ;
  153. notp:    cpi    'U'
  154.     jnz    notu
  155.     sta    optu
  156.     jmp    scnops
  157. ;
  158. notu:    cpi    '0'
  159.     jnz    not0
  160.     sta    opt0
  161.     jmp    scnops
  162. ;
  163. not0:    cpi    '1'
  164.     jnz    not1
  165.     sta    opt1
  166.     jmp    scnops
  167. ;
  168. not1:    cpi    '2'
  169.     jnz    not2
  170.     sta    opt2
  171.     jmp    scnops
  172. ;
  173. invalid:
  174. not2:    sta    badopt;        Save the offender
  175.     cpm    msg,badmsg;    Print the message
  176. ;    "    "
  177. abend:    xra    a
  178.     call    sgusr;        subfile ops on user 0
  179.     cpm    del,subfile;    Cancel the Jobstream
  180.     cpm    msg,canmsg;    Print cancel message
  181.     call    suser;        Restore entry user
  182.     jmp    boot;        Boot the system
  183. ;
  184. badmsg:    db    'Option "'
  185. badopt:    db    0
  186.     db    '" invalid.'
  187.     db    '$'
  188. ;
  189. canmsg:    db    '...CANCELED'
  190.     db    '$'
  191. ;
  192. ; The option list has been scanned
  193. ; Now check the active ones in a logical order.
  194. finscn:    lda    optd;        Option D
  195.     ora    a;        if set means 
  196.     cnz    drvsub;        Drive substitution.
  197. ;    "    "
  198.     lda    opta;        Option A
  199.     ora    a;        if set means
  200.     cnz    chka;        Ambiguous spec required.
  201.     jc    evalfls;    (false condition if not met)
  202. ;    "    "
  203.     lda    optu;        Option U
  204.     ora    a;        if set means
  205.     cmc
  206.     cnz    chka;        Unambiguous spec required.
  207.     jnc    evalfls;    (false if ambiguous)
  208. ;    "    "
  209.     lda    opt0;        Option 0
  210.     ora    a;        if set means
  211.     cnz    chk0;        drives must match
  212.     jc    evalfls
  213. ;    "    "
  214.     lda    opt1;        Option 1
  215.     ora    a;        if set means
  216.     cnz    chk1;        names must match
  217.     jc    evalfls
  218. ;    "    "
  219.     lda    opt2;        Option 2
  220.     ora    a;        if set means
  221.     cnz    chk2;        extensions (types) must match
  222.     jc    evalfls
  223. ;    "    "
  224.     lda    optc;        Option C
  225.     ora    a;        if set means
  226.     cnz    chkc;        Contents are required
  227.     jc    evalfls
  228. ;    "    "
  229.     lda    opte;        Option E
  230.     ora    a;        if set means
  231.     cnz    chke;        Must be empty (or missing)
  232.     jc    evalfls
  233. ;    "    "
  234.     lda    optp;        Option P
  235.     ora    a
  236.     cnz    chkp;        Presence required (C or E)
  237.     jc    evalfls
  238. ;    "    "
  239.     lda    optm;        Option M
  240.     ora    a
  241.     cmc
  242.     cnz    chkp;        must be Missing (not P)
  243.     jnc    evalfls
  244. ;    "    "
  245.     lda    optn;        No option list means
  246.     ora    a
  247.     cnz    chkn;        Any parm ok except blank
  248.     jc    evalfls
  249. ;    "    "
  250. ; The tests have all evaluated true.
  251. ; do the next line in the submit file. In other words, do nothing.
  252. evaltru:
  253. ;    "    "
  254. exit:    call    suser;        Restore entry user
  255.     pop    h;        Old stack pointer
  256.     sphl;            Reset to entry stack
  257.     ret;            Return to CCP
  258. ;
  259. ; At least one test failed. Remove the next line from the submit file.
  260. evalfls:
  261.     xra    a
  262.     call    sgusr;        Do subfile operations on user #0
  263.     cpm    opn,subfile;    Open the $$$.SUB file.
  264.     inr    a;        Test return code.
  265.     jz    suberr;        Not within a .SUB file??
  266.     lxi    h,subfile+fcbrc; Record counter for the extent
  267.     dcr    m;         decreases by one.
  268.     jm    suberr;        No following line??
  269.      dcx    h;        The S2 byte just below it
  270.     mvi    m,0;         is zeroed to mark file altered.
  271.     cpm    cls,subfile;    Write change to directory.
  272.     inr    a;        Trouble?
  273.     jz    suberr
  274.     jmp    exit;        Ok, all finished.
  275. ;
  276. ; Something is wrong with the $$$.SUB file.
  277. suberr:    cpm    msg,submsg;    Inform user
  278.     jmp    abend;        bail out.
  279. ;
  280. submsg:    db    'Error accessing .SUB file.'
  281.     db    '$'
  282. ;
  283. ; Here are the routines which do the actual condition checks.
  284. ; All of them return with the zero flag set if the condition
  285. ; tested is true, and with the carry flag set if false.
  286. ; a,f
  287. retcy:    xra    a
  288.     sui    1
  289.     ret
  290. ;
  291. drvsub:;    Not really a test, just move drive spec from
  292. ;    parm1 to parm2 for use in other tests
  293. ;    lda    tfcb1
  294. ;    sta    tfcb1
  295. ;    ret;            leave zero flag set
  296. ;
  297. ; see if parm1 is ambiguous
  298. chka:    lxi    h,tfcb1+1;    start at name
  299.     mvi    a,'?';        check for "?". No need to
  300. ;    "    "         check for * since CCP
  301. ;    "    "         has done expansion.
  302.     mvi    c,8+3;        'xxxxxxxxyyy'
  303. chka01:    cmp    m;        is this one a wildcard?
  304.     rz;            True return
  305.     inx    h;        Point to next one
  306.     dcr    c;        count down
  307.     jnz    chka01;        Keep testing till done.
  308.     jmp    retcy;        False return
  309. ;
  310. ; see if drives match.
  311. ;
  312. chk0:    cpm    cur;        Find out current default
  313.     inr    a;        Drive A becomes 1
  314.     mov    d,a;        Default in D
  315.     lda    tfcb1
  316.     ora    a;        See if Parm1 says default
  317.     jnz    chk001
  318.     mov    a,d;        Substitute current default
  319. chk001:    mov    b,a;        Save Parm1 drive in B
  320.     lda    tfcb2
  321.     ora    a;        See if Parm2 says default
  322.     jnz    chk002
  323.     mov    a,d
  324. chk002:    cmp    b;        compare with Parm 1
  325.     rz;            return true
  326.     jmp    retcy;        return false
  327. ;
  328. ; Compare name fields for a match.
  329. ;
  330. chk1:    lxi    h,tfcb1+1
  331.     lxi    d,tfcb2+1
  332.     mvi    c,8
  333. chk101: ldax    d;        get parm2 char
  334.     cpi    '?';        chk wild
  335.     jz    chk102;        treat as match
  336.     mov    b,a
  337.     mov    a,m;        get parm1 char
  338.     cpi    '?';        chk wild
  339.     jz    chk102;        treat as match
  340.     cmp    b;        compare 1 with 2
  341.     jnz    retcy;        Return false
  342. chk102:    inx    d
  343.     inx    h
  344.     dcr    c
  345.     jnz    chk101;        Ok so far, keep going
  346.     xra    a;        clear carry, set zero
  347.     ret
  348. ;
  349. ; Compare filetypes as above
  350. ;    
  351. chk2:    lxi    h,tfcb1+1+8
  352.     lxi    d,tfcb2+1+8
  353.     mvi    c,3;        Shorter length
  354.     jmp    chk101;         otherwise same algorithm
  355. ;
  356. ; Check directory for file
  357. ;    
  358. chkp:    cpm    opn,tfcb
  359.     inr    a;        test return code
  360.     jz    retcy;        return false 
  361.     xra    a;        else
  362.     ret;            return true
  363. ;
  364. ; Check file contents
  365. ;    
  366. chkc:    call    chka;        Ambiguity is meaningless
  367.     jz    retcy
  368.     call    chkp;        Must be present, of course
  369.     rc
  370. chkc01:    cpm    ver;        check version
  371.     cpi    20h;        2.0 or better?
  372.     jc    chkc14;        No, can't use size function
  373. chkc20:    xra    a
  374.     sta    tfcb+fcbr2;    Clear high record byte
  375.     cpm    siz,tfcb;    Compute file size
  376.     lxi    h,tfcb+fcbr0
  377.     mov    a,m
  378.     inx    h
  379.     ora    m
  380.     inx    h
  381.     ora    m;        zero set if empty
  382.     jz    retcy;        return false
  383.      xra    a;        return true
  384.     ret
  385. ;
  386. ; Version 1.4 or older CP/M.  Just do a read.
  387. chkc14:    cpm    dma,tbuff
  388.     cpm    frd,tfcb;    Read Sequential
  389.     ora    a;        Test code
  390.     rz;            return true
  391.     stc;            return false
  392.     ret
  393. ;
  394. ; Check for empty file
  395. ;    
  396. chke:    call    chka;        Still must be unambiguous
  397.     jz    retcy
  398.     call    chkp;        If missing, call it empty
  399.     jc    retzro
  400.     call    chkc01;        check for contents
  401.     jz    retcy;        return false (not empty)
  402.     xra    a
  403.     ret;            return true  (empty)
  404. ;
  405. ; check for any hint of a parm1 entry
  406. ;    
  407. chkn:    lda    tfcb;        Point to drive spec
  408.     ora    a
  409.     jnz    retzro;        Return true for any drive
  410.     lda    tfcb+1    
  411.     cpi    ' '
  412.     jnz    retzro;        Return true for any name
  413.     lda    tfcb+9
  414.     cpi    ' '
  415.     jz    retcy;        No type either.  False
  416. retzro:    xra    a
  417.     ret
  418. ;
  419. ; Upshift (a) if lower case.  Carry if upshifted, else a unchanged
  420. ; a,f
  421. upshft:    cpi    'z' + 1
  422.     rnc;            not lower case
  423.     cpi    'a'
  424.     cmc
  425.     rnc
  426.     adi    'A'-'a';    causes carry
  427.     ret
  428. ;
  429. ; reset user #
  430. suser:    lda    user
  431. ;    "    "
  432. ; set/get user (a)
  433. sgusr:    mov    e,a
  434.     cpm    usr
  435.     ret
  436. ;
  437. ; +-----------------------------+
  438. ; |    Working Storage        |
  439. ; +-----------------------------+
  440. ;
  441. opta:    db    0;        default options not selected
  442. optc:    db    0
  443. optd:    db    0
  444. opte:    db    0
  445. optm:    db    0
  446. optn:    db    0
  447. optp:    db    0
  448. optu:    db    0
  449. opt0:    db    0
  450. opt1:    db    0
  451. opt2:    db    0
  452. ;
  453. ; File Control Block for submit file.
  454. subfile:
  455.     db    1;        Drive A:
  456.     db    '$$$     SUB'
  457.     db    0,0,0,0
  458.     ds    subfile-$+36;    Remainder of 36 bytes
  459. ;
  460. user    ds    1;        User no. on entry
  461. ;
  462. ; Local Stack area
  463.     ds    48
  464. lclstak equ    $
  465. ;
  466.     end    ifprog
  467. ╙O