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 / SUBMIT / IFSKIP21.LBR / SKIP.MQC / SKIP.MAC
Text File  |  2000-06-30  |  4KB  |  213 lines
  1.  title '//SKIP.MAC Transfer control in Submit file'
  2. ;
  3. ; by Gary Novasielski.
  4. ;
  5. ; 2.1    86/10/16 $$$.SUB file always on A0: for CCP+
  6. ;
  7. ; 2.0    85/10/20 accepts ";" indicating remainder of
  8. ;     line is a comment.  C.B. Falconer
  9. ;
  10. version    equ    21;        was 10
  11. ;
  12. @msg    set    9
  13. @opn    set    15
  14. @cls    set    16
  15. @del    set    19
  16. @usr    set    32
  17. query    equ    0ffh;        queries to CPM
  18. ;
  19. cpmbase    equ    0
  20. boot    set    cpmbase
  21. bdos    set    boot+5
  22. tbuff    equ    boot+80h
  23. tpa    equ    boot+100h
  24. ctrl    equ    ' '-1;        Ctrl char mask
  25. cr    set    ctrl and 'M'
  26. lf    set    ctrl and 'J'
  27. ;
  28. cpm    macro    func,operand
  29.     if    not nul operand
  30.      lxi    d,operand
  31.     endif;;        of not nul operand
  32.     if    not nul func
  33.      mvi    c,@&func
  34.     endif
  35.     call    bdos
  36.     endm
  37. ;
  38. fcbs2    equ    14
  39. fcbrc    equ    15
  40. fcbr0    equ    33;    Offsets into File Control Blocks
  41. fcbr1    equ    34
  42. fcbr2    equ    35
  43. ;
  44.     org    tpa
  45. ;
  46. skipprog:
  47.     jmp    pastc
  48. ;
  49.     db    ' V', version/10+'0', '.', version mod 10+'0'
  50.     db    ' Copyright (c) 1982 Gary P. Novosielski '
  51.     db    ctrl and 'Z'
  52. ;
  53. pastc:    lxi    h,0;        Clear HL
  54.     dad    sp;        Get Stack Pointer value
  55.     lxi    sp,lclstak;    Set up local stack
  56.     push    h;        Save old SP on new stack
  57. ;    "    "
  58.     mvi    a,query
  59.     call    sgusr
  60.     sta    user;        save entry user
  61.     mvi    e,0
  62.     cpm    usr;        rest is on user 0
  63.     lxi    h,tbuff;    point to Command Buffer
  64.     mov    a,m;        get count
  65.     inr    a;        Point past end of string
  66.     call    hlxa;        Index the pointer
  67.     mvi    m,0;        Insist on null terminator
  68. ;    "    "
  69.     lxi    h,tbuff+1;    base of command buffer
  70.     call    scnb;        scan to first non-blank
  71.     ora    a;        An argument present?
  72.     jnz    evalarg;    Yes, evaluate it.
  73.     cpi    ';'
  74.     jnz    evalarg;    not terminated by ; for comment
  75.     lxi    h,1;        Else default to one
  76.     jmp    evalexit;    Don't do the loop
  77. ;
  78. evalarg:
  79.     xchg;            Scan pointer to DE
  80.     lxi    h,0;        initialize value
  81. evaloop:
  82.     ldax    d;        Get character
  83.     ora    a;        Terminator?
  84.     jz    evalexit;    exit loop
  85.     cpi    ';'
  86.     jz    evalexit;    rest of line is comment
  87. ;    "    "
  88.     call    isnum;        Test range 0-9 ASCII
  89.     jc    notnum;        argument not numeric
  90.     sui    '0';        Make it binary
  91. ;    "    "
  92. ;    Multiply current value in HL by 10
  93.     mov    b,h
  94.     mov    c,l
  95.     dad    b;    *2
  96.     dad    h;    *4
  97.     dad    b;    *5
  98.     dad    h;    *10
  99. ;    "    "
  100. ;    Add in new value from A
  101.     call    hlxa
  102. ;    "    "
  103.     inx    d;        bump argument pointer
  104.     jmp    evaloop
  105. ;
  106. ; Range test.  Must be 1-127
  107. evalexit:
  108.     mov    a,l
  109.     ani    080h
  110.     ora    h
  111.     jnz    rangerr
  112.     ora    l
  113.     jz    exit;        Skip 0 lines = do nothing
  114. ;    "    "
  115. ; OK so far. Now skip over (L) lines in the .SUB file
  116.     push    h;        Save the value
  117.     cpm    opn,subfile;    Open the $$$.SUB file.
  118.     pop    d;        Restore the value
  119. ;    "    "
  120.     inr    a;        Test return code.
  121.     jz    suberr;        Not within a .SUB file??
  122.     lxi    h,subfile+fcbrc; Record counter for the extent
  123.     mov    a,m
  124. ;    "    "
  125.     sub    e;        Reduce by number skipped and
  126.     jc    nelerr;         (Not enough lines remaining)
  127. ;    "    "
  128.     mov    m,a;         put back into the FCB
  129.     xra    a;        And a zero goes into
  130.     sta    subfile+fcbs2;    the S2 byte to mark file altered
  131.     cpm    cls,subfile;    Write change to directory.
  132.     inr    a;        Trouble?
  133.     jz    suberr
  134. ;    "    "
  135. ; Ok, all finished.
  136. exit:    call    suser;        restore entry user
  137.     pop    h;        Old SP
  138.     sphl;            Restore Stack
  139.     ret;            to Console Command Processor
  140. ;
  141. suberr:    call    abend
  142.     db    'Error accessing .SUB file.'
  143.     db    '$'
  144. ;
  145. ; Argument is not numeric
  146. notnum:    call    abend
  147.     db    '//SKIP argument not numeric.'
  148.     db    '$'
  149. ;
  150. rangerr:
  151. nelerr:    call    abend
  152.     db    '//SKIP argument exceeds file size.'
  153.     db    '$'
  154. ;
  155. abend:    pop    d;        Message address
  156.     cpm    msg;        Send to console
  157.     cpm    del,subfile;    Abort the jobstream
  158.     cpm    msg,cancel
  159.     call    suser;        restore entry user
  160.     jmp    boot
  161. ;
  162. cancel:    db    '...CANCELED'
  163.     db    '$'
  164. ;
  165. ;
  166. ; Utility subroutines
  167. ;
  168. ; set user #
  169. suser:    lda    user
  170. ;    "    "
  171. ; set/get user #
  172. sgusr:    mov    e,a
  173.     cpm    usr
  174.     ret
  175. ;
  176. ; Index HL by the value of A. Returned flags not defined
  177. ; a,f,h,l
  178. hlxa:    add    l
  179.     mov    l,a
  180.     adc    h
  181.     sub    l
  182.     mov    h,a
  183.     ret
  184. ;
  185. ; Scan over leading blanks. Return char in A
  186. ; a,f,h,l
  187. scnb:    mov    a,m
  188.     cpi    ' '
  189.     rnz
  190.     inx    h
  191.     jmp    scnb
  192. ;
  193. ; Return carry set if not ASCII decimal char 0-9.
  194. ; f
  195. isnum:    cpi    '0'
  196.     rc
  197.     cpi    '9'+1
  198.     cmc
  199.     ret
  200. ;
  201. user:    db    0;        User # at entry
  202. ;
  203. subfile:    
  204.     db    1;        Drive A:
  205.     db    '$$$     SUB'
  206.     db    0,0,0,0
  207.     ds    subfile-$+36
  208. ;
  209.     ds    48
  210. lclstak    equ    $
  211. ;
  212.     end    skipprog
  213. ▐M