home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / utils / squsq / fcrlzh11.lbr / FCRLZH11.MYC / FCRLZH11.MYC
Text File  |  1989-12-12  |  21KB  |  924 lines
  1. title    'FCRLZH multi-file LZH encoder'
  2. ;
  3. ver        equ    11
  4. ;
  5. ; Based on FCRUNCH (see below)
  6. ;
  7. ; 1.1   (89/09/08) No previous revision.  Output file name uses
  8. ;       'Y', rather than 'Z'.
  9. ;
  10. ;--------------------FCRUNCH DOCS FOLLOW------------------------
  11. ;
  12. ; Crunch file 1 to file 2.  By C.B. Falconer.
  13. ;
  14. ;   d>FCRUNCH [-[c][k][p][q]] [d[u]:]afnin.aft [d[u]:][afnout.aft]
  15. ;        crunches afnin.aft to afnout.aft
  16. ;        (with full du addressing, across users, drives)
  17. ; the (optional) -c causes confirmation per file crunched
  18. ;         -k causes no existing files to be erased
  19. ;         -p causes existing output file erasure
  20. ;         -q suppresses running messages
  21. ; Default output name is input with a middle Z in filetype.
  22. ;
  23. ; 1.1    (86/12/20) Only version # changed, relinked to CRN v25, which
  24. ;    allows for trapping of particular output sequences.  This now
  25. ;    traps the sequence <0dh>,<040h> (with possible high bits set)
  26. ;    and injects a nulcode to output.  This avoids problems with
  27. ;    Telenet/PcPursuit (or so I am told).  CRN can be configured
  28. ;    to trap any 2 byte sequence, by reassembly.    - cbf
  29. ;
  30. ; Created as a modification of FCOPY 1.1.  Needs BUFFLIB v1.4 up
  31. ;
  32. ; ASSEMBLY    (rmac is not usable without changes)
  33. ;    A>m80 fcrlzh11,=fcrlzh11
  34. ; or
  35. ;    A>slrmac fcrlzh11/r        (much faster)
  36. ;
  37. ;    CAUTION - nnnn/mmmm numbers below are examples, can change
  38. ;
  39. ; LINKING with L80  (slowest by far)
  40. ;
  41. ;    A>l80 /p:100,/d:4000,fcrlzh11,crlzh,bufflib/s,/u,/r
  42. ;
  43. ;    Link-80  3.44   . . . . 
  44. ;    Data    4000    405A    <   90>
  45. ;    Program 0100    0ADD    < dddd>
  46. ;
  47. ;    */p:100,/d:nnnn,fcrlzh11,crlzh,bufflib/s,fcrlzh11/n,/e
  48. ;            ^ using nnnn = 0ADD from above line (example)
  49. ;
  50. ; LINKING with SLRNK
  51. ;
  52. ;    A>slrnk /p:100,/d:4000,fcrlzh11,crlzh,bufflib/s,/u,/r
  53. ;
  54. ;    Superlinker . . . .
  55. ;    0100-0ADC  (09DD)       973E left
  56. ;    Superlinker . . . .
  57. ;
  58. ;    %/p:100,/d:mmmm,fcrlzh11,crlzh,bufflib/s,fcrlzh11/n,/e
  59. ;            ^ using mmmm = 0ADD, i.e. 0ADC + 1 (example)
  60. ;
  61. ; LINKING with SLRNK+  (fastest and easiest, no copying numbers)
  62. ;
  63. ;A>slrnk+ /a:100,/j,fcrlzh11,crlzh,bufflib/s,fcrlzh11/n,/e
  64. ;                        (does it all)
  65. ; 
  66. ; Externals in BUFFLIB.    See BUFFERS.DOC
  67.     extrn    .getusr,  .xltusr, .setusr;    user parsing
  68.     extrn    .wildx,      .wldck,  .pfnmdu;    file parsing
  69.     extrn    .options, .skipblks;        command parsing
  70.     extrn    .fncpy,      .nxtout, .nxtfn;    fname operations
  71.     extrn    .dos;                bdos(a), save regs
  72.     extrn    .idiv,      .imul,   .dcmp
  73.     extrn    .tdzs,      .tfnam,  .crlf;    utility
  74.     extrn    .couta,      .tdzsf,  .blk
  75.     extrn    .initfcb, .drvlock
  76.     extrn    .bfwopen, .bfclose;        write opens/close
  77.     extrn    .bfropen;            read opens
  78.     extrn    .bfgetc,  .bfputc;        buffered file i/o
  79.     extrn    b.ohead;            ext. constants
  80.     extrn    .bver;                library version
  81.     extrn    .endata;            Available memory area
  82. ;
  83.     extrn    crlzh;                crunch package
  84.  
  85.     entry    glzhen, plzhen;            crlzh i/o
  86. ;
  87. buflibver    equ    14;        minimum to link
  88. stkmargin    equ    5*1400h + 256;    bytes for crlzh & stack
  89. ;
  90. boot    equ    0
  91. bdos    equ    boot+5
  92. tfcb    equ    boot+05ch;    used to hold outname template
  93. defdma    equ    boot+080h
  94. ;
  95. cr    equ    0dh
  96. lf    equ    0ah
  97. t    equ    09h
  98. crnchid    equ    076fdh;        Standard header
  99. stpmax    equ    40;        max size (+1) of any stamp
  100. ;
  101. ; errors
  102. xhelp    equ    0;        no error, give help
  103. xempty    equ    1;        file empty
  104. xcrn    equ    2;        file already crunched/squeezed
  105. xstkovf    equ    3;        memory overflow
  106. xwild    equ    4;        incompatible wildcards
  107. xtoself    equ    5;        copying into self
  108. xnodir    equ    6;        fcreate failure
  109. xwrterr    equ    7;        write error
  110. xusrabt    equ    8;        user abort
  111. xbadlib    equ    9;        linked to wrong library
  112. xsaved    equ    10;        Old file not eraseable
  113. xbadnam    equ    11;        Unable to create new name
  114. xnofile    equ    12;        input file not found
  115. xok    equ    13;        done, without errors
  116. ;
  117. ; Dos function calls
  118. cin    equ    1
  119. pstrg    equ    9
  120. csta    equ    11
  121. @fopen    equ    15
  122. @purge    equ    19
  123. ;
  124. ; Initialize
  125. begin:    jmp    bgn
  126. ;
  127. ; Option image.  Zero locations to pre-set.
  128. ; Make letters lower case to forbid setting.
  129. optimg:    db    '-',optlgh
  130.     db    'C';        Confirm "crunch this file" option
  131.     db    'K';        Keep pre-existing output files
  132.     db    'P';        purge pre-existing output files
  133.     db    'Q';        Quiet option.
  134. optlgh    equ    $-optimg-2
  135. ;
  136. ; Start up here
  137. bgn:    lhld    bdos+1
  138.     mvi    l,0;        set stack at top of memory
  139.     sphl
  140.     call    .getusr
  141.     sta    entryusr
  142.     call    .bver;        This also ensures the lib version
  143.     cpi    buflibver;    module is linked and identified
  144.     mvi    a,xbadlib
  145.     jc    exeunt;        linked to wrong library
  146.     lxi    h,0
  147.     shld    filesdone;    zero count of files processed
  148.     shld    stamp;        default empty stamp
  149.     lxi    d,defdma
  150.     call    markeol;    of input command line
  151.     inx    d
  152.     lxi    b,optimg
  153.     lxi    h,options
  154.     call    .options;    from de^
  155. ;    "    "
  156. ; parse in/out file names
  157.     lxi    h,fcbout
  158.     call    .initfcb
  159.     lxi    h,fcbin
  160.     call    .initfcb;    init in and out fcbs
  161.     call    .pfnmdu
  162.     mov    a,b;        is 0 for default, else usr+1
  163.     call    usrlok;        now 1..max
  164.     sta    inuser
  165.     lxi    h,tfcb
  166.     call    .initfcb
  167.     mvi    b,0;        in case no 2nd file parsed
  168.     call    .skipblks
  169.     cpi    '['
  170.     cnz    .pfnmdu;    no 2nd spec, reached the stamp
  171.     push    d;        save input parse pointer
  172.     mov    a,b
  173.     call    usrlok;        now 1..max, no defaults left
  174.     sta    outuser
  175.     lxi    d,fcbin;    ensure locked to drive for compare
  176.     call    .drvlock;     else default and specific drives
  177.     lxi    d,tfcb;         may erroneously appear different
  178.     call    .drvlock
  179.     ldax    d
  180.     sta    fcbout;        set output drive id
  181.     lda    fcbin+1
  182.     pop    d;        get input parse pointer back
  183.     sui    ' '
  184.     jz    exeunt;        a=0, help message
  185. ;    "    "
  186. ; Parse the remaining tail into the stamp buffer
  187.     call    rstamp;        from de^
  188. ;    "    "
  189. ; Set default output names, check compatible wild cards
  190.     lxi    h,fcbin
  191.     lxi    d,tfcb
  192.     call    sdefault;    if no output, make same as input
  193.     call    .wldck;        Check wild cards compatible
  194.     mvi    a,xwild
  195.     jc    exeunt;        Incompatible wildcards
  196. ;    "    "
  197. ; Expand any wild cards
  198.     lxi    h,.endata
  199.     shld    fnptr
  200.     lda    inuser
  201.     dcr    a
  202.     call    .setusr
  203.     lxi    d,fcbin
  204.     call    .wildx;        expand fcbin into wild list
  205.     mvi    a,xstkovf
  206.     jc    exeunt;        Ran out of memory
  207.     shld    @outbuff;    mark available memory
  208.     xchg;            de := @outbuff
  209.     mov    l,c
  210.     mov    h,b
  211.     shld    fncount;    number of files matched
  212. ;    "    "
  213. ; Calculate space available for buffers and allocate them
  214.     lxi    h,b.ohead+b.ohead
  215.     dad    d
  216.     xchg;            adjust base of storage
  217.     lxi    h,-stkmargin
  218.     dad    sp
  219.     mvi    a,0;        round down to page boundary
  220.     sub    e
  221.     mov    e,a
  222.     mov    a,h
  223.     sbb    d
  224.     mov    d,a;        form buffer size available
  225.     xchg
  226.     lxi    d,0;        0 extend
  227.     lxi    b,3
  228.     call    .idiv;        one third for outbuffer
  229.     xchg
  230.     mov    a,l
  231.     ani    080h;        round down to multiple of 128
  232.     mov    l,a
  233.     shld    bufsize
  234.     ora    h
  235.     mvi    a,xstkovf
  236.     jz    exeunt;        0 size buffers just wont do
  237.     lxi    d,b.ohead
  238.     dad    d;        space needed for complete buffer
  239.     xchg
  240.     lhld    @outbuff
  241.     dad    d
  242.     shld    @inbuff;    locate past output buffer
  243.     lxi    d,b.ohead
  244.     dad    d
  245.     xchg
  246.     lhld    bufsize
  247.     dad    h;        double, two thirds for input buffer
  248.     dad    d
  249.     shld    @freemem;    and locate available memory
  250. ;    "    "
  251. ; Now tfcb holds output file pattern, fnptr points to next input file
  252. ; name, and fncount holds file count to process.  @outbuff points just
  253. ; above the file list and is allocated, @inbuff is allocated, memory
  254. ; from @freemem up, less an allowance for stack use, is available.
  255. copy:    lhld    fncount
  256.     mov    a,h
  257.     ora    l
  258.     dcx    h
  259.     shld    fncount
  260.     jz    done;        no more files
  261.     call    setfiles;    setup input/output file names
  262.     mvi    a,xbadnam
  263.     push    psw
  264.     call    showf;        file names set up
  265.     pop    psw
  266.     jc    exeunt;        Can't setup this name
  267.     lda    confirm
  268.     ora    a
  269.     cz    askcfm
  270.     jz    copy;        ignore, try next
  271.     lhld    outuser;    to l
  272.     lda    inuser
  273.     cmp    l
  274.     lxi    h,fcbout
  275.     lxi    d,fcbin
  276.     cz    cmpfns;        users same, compare file names/drv
  277.     mvi    a,xtoself
  278.     jz    exeunt;        can't copy to self
  279.     lhld    bufsize
  280.     dad    h;        * 2 for input
  281.     mov    c,l
  282.     mov    b,h
  283.     lhld    @inbuff
  284.     lxi    d,fcbin
  285.     lda    inuser
  286.     call    .bfropen;    open buffered input system
  287.     mvi    a,xnofile
  288.     jc    exeunt;        input file not found
  289.     lxi    d,fcbout
  290.     lda    purge
  291.     ora    a
  292.     lda    outuser
  293.     cnz    chkpurge;    Check for erasure of old file
  294.     mvi    a,xsaved
  295.     jnz    copy2;        and treat NO as an error
  296.     call    .crlf
  297.     lda    outuser
  298.     lhld    bufsize
  299.     mov    c,l
  300.     mov    b,h
  301.     lhld    @outbuff
  302.     call    .bfwopen;    open buffered output file
  303.     mvi    a,xnodir
  304.     jc    exeunt;        fopen error
  305.     call    crnch
  306.     jc    copy1
  307.     lhld    filesdone
  308.     inx    h
  309.     shld    filesdone
  310.     jmp    copy;        no error
  311. ;
  312. ; error (a).  If non-terminal delete output file and continue, 
  313. ; otherwise abort everything.
  314. copy1:    call    delout
  315. copy2:    cpi    xstkovf
  316.     jz    exeunt;        abort everything
  317.     call    msgptr
  318.     call    tstr
  319.     jmp    copy
  320. ;
  321. ; purge output file
  322. delout:    push    psw
  323.     push    d
  324.     lda    outuser
  325.     dcr    a
  326.     call    .setusr
  327.     lxi    d,fcbout
  328.     mvi    a,@purge
  329.     call    .dos;        remove the partial file
  330.     pop    d
  331.     pop    psw
  332.     ret
  333. ;
  334. done:    lhld    filesdone
  335.     mov    a,h
  336.     ora    l
  337.     mvi    a,xnofile
  338.     jz    exeunt;        no files found
  339.     call    .crlf
  340.     call    .tdzs
  341.     mvi    a,xok
  342. ;    "    "
  343. ; output message index (a) and exit
  344. exeunt:    call    msgptr
  345.     call    tstr
  346.     lda    entryusr;    restore user at entry
  347.     call    .setusr
  348.     jmp    boot
  349. ;
  350. ; convert error index (a) into pointer (de) to error message
  351. ; a,f,d,e,h,l
  352. msgptr:    lxi    h,errtbl
  353.     add    a
  354.     add    l
  355.     mov    l,a;        point to msgtable entry (a)
  356.     adc    h
  357.     sub    l
  358.     mov    h,a
  359.     mov    e,m;        get pointer to message
  360.     inx    h
  361.     mov    d,m
  362.     ret
  363. ;
  364. ; messages for error codes 0 up
  365. ;        ERROR MESSAGES        ERROR CODES (0 up)
  366. errtbl:    dw    helpmsg,   emptymsg;    xhelp,     xempty
  367.     dw    xcrnmsg,   nomemsg;    xcrn,     xstkovf
  368.     dw    wildmsg,   selfmsg;    xwild,     xtoself
  369.     dw    nodirmsg,  wrterrmsg;    xnodir,     xwrterr
  370.     dw    abtmsg,    badlibmsg;    xusrabt, xbadlib
  371.     dw    ignoremsg, badnamsg;    xsaved,     xbadnam
  372.     dw    nofind,    filesmsg;    xnofile, xok
  373. ;
  374. helpmsg:
  375. db 'FCRLZH v', ver/10 + '0', '.', ver MOD 10 + '0',cr,lf
  376. db    ' Portions by C.B. Falconer',cr,lf
  377. db    ' LZH encoding by R. Warren',cr,lf,lf
  378. ;   1234567-1234567-1234567-1234567-1234567-1234567-1234567-
  379. db '      keep old   quiet  input file',t, 'output file',cr,lf
  380. db t,      '     \     \',t, t,    ' \',t,  t,     '\',cr,lf
  381. db 'FCRLZH  {-{c}{k}{p}{q}} {d{u}:}afnin.aft {d{u}:}{afout.aft} {[id]}'
  382. db cr,lf
  383. db t,      '  /     /',t,   ' /',t, t,     '  /',t, t,     '     /'
  384. db cr,lf
  385. db '   confirm   purge   source',t,'destination',t,t,      'idstring'
  386. db cr,lf,lf
  387. ;   1234567-1234567-1234567-1234567-1234567-1234567-1234567-1234567-
  388. db t,'[idstring] is anything enclosed in []',cr,lf
  389. db t,'default destination is source name with modified "typ"',cr,lf,lf
  390. db 'ex: FCRLZH -p b5:fcopy.* c6:',t,'(LZH encodes to C6: and erases)'
  391. db cr,lf,'$'
  392. xcrnmsg:    db    'File already squeezed/crunched/LZH encoded',cr,lf,'$'
  393. emptymsg:    db    'Empty file',cr,lf,'$'
  394. nomemsg:    db    cr,lf,'Insufficient memory, '
  395. abtmsg:        db    '..ABORTED..$'
  396. wildmsg:    db    'Incompatible wild cards, from/to$'
  397. selfmsg:    db    'Can''t process file to itself$'
  398. nodirmsg:    db    'Can''t create, directory full?$'
  399. wrterrmsg:    db    'Write error, disk full?$'
  400. badlibmsg:    db    'Linked to obsolete library$'
  401. ignoremsg:    db    ' Not erased..',cr,lf,'$'
  402. badnamsg:    db    ' Rename this input file$'
  403. nofind:        db    ' Not found, no'
  404. filesmsg:    db    ' files processed$'
  405. ;
  406. ; mark end-of-line with nul, text buffer de^
  407. ; a,f,h,l
  408. markeol:
  409.     ldax    d
  410.     mov    l,a
  411.     xra    a
  412.     mov    h,a
  413.     dad    d
  414.     inx    h
  415.     mov    m,a;        mark eol
  416.     ret
  417. ;
  418. ; Check for existance of file de^, user a.  If found, query for
  419. ; erasure. Return z flag if not found, or if erasure permitted
  420. ; a,f
  421. chkpurge:
  422.     dcr    a;        Using buffers variant for user
  423.     call    .setusr
  424.     mvi    a,@fopen
  425.     call    .dos
  426.     inr    a
  427.     rz;            not found, all well
  428.     lda    keepem
  429.     ora    a
  430.     jz    chkpg1;        0 is not a Y, no purge
  431.     push    d
  432.     lxi    d,query
  433.     call    tstr
  434.     pop    d
  435.     call    cupsft
  436. chkpg1:    cpi    'Y';        Z flag for permission
  437.     ret
  438. ;
  439. query:    db    ' Exists, ok to purge (y/N) ? $'
  440. qcnfm:    db    ' LZH Encode it (Y/n) ? $'
  441. ;
  442. ; ask to confirm squeezing this file.  Z flag for no
  443. ; a,f
  444. askcfm:    push    d
  445.     lxi    d,qcnfm
  446.     call    tstr
  447.     pop    d
  448. ;    "    "
  449. ; Console input char and kludgy upshift.  Compared to 'N'
  450. ; a,f
  451. cupsft:    mvi    a,cin
  452.     call    .dos
  453.     ani    05fh
  454.     cpi    'N'
  455.     ret
  456. ;
  457. ; make file de^ same name as hl^ (name/ext only) if no spec
  458. ; a,f
  459. sdefault:
  460.     inx    d
  461.     ldax    d
  462.     sui    ' '
  463.     sta    outspec;    non-zero means output specified
  464.     ldax    d
  465.     dcx    d
  466.     rnz
  467.     jmp    .fncpy;        no specification, copy it
  468. ;
  469. ; Column header for noisy display
  470. colhdr:    lxi    d,colmsg
  471. ;    "    "
  472. ; String de^ to console
  473. ; a,f
  474. tstr:    mvi    a,pstrg
  475.     jmp    .dos
  476.  
  477. colmsg:    db    '    in   out ratio    ca    cr',cr,lf
  478.     db    '    ==   === =====    ==    ==',cr,lf,'$'
  479. ;
  480. ; All files open, and buffers assigned.
  481. ; Crunch fcbin to fcbout byte by byte.
  482. crnch:    lda    quiet
  483.     ora    a
  484.     cnz    colhdr
  485.     lxi    h,0
  486.     shld    cksum
  487.     dad    sp
  488.     shld    savesp;        in case of error
  489.     call    header;        Make the standard header
  490.     lxi    h,0;        Zero for..
  491.     shld    incnt;        Input count
  492.     shld    incnt+2;    Input count
  493.     shld    outcnt;        Output count
  494.     shld    outcnt+2;    Output count
  495.     shld    nxtcod;        Needed by display stuff
  496.     shld    ttotal;        Needed by display stuff
  497.  
  498.     lhld    @freemem;    Where to put the tables
  499.     mvi    a,00;        use checksum
  500.     call    crlzh;        invoke
  501.     rc;            error exit
  502.     lhld    cksum
  503.     mov    a,l
  504.     call    outbyt
  505.     mov    a,h
  506.     call    outbyt;        include the checksum
  507.     lhld    @outbuff
  508.     call    .bfclose;    close the output file
  509.     lhld    xtraout
  510.     inx    h
  511.     inx    h
  512.     shld    xtraout;    allow for checksum
  513.     lda    quiet
  514.     ora    a
  515.     rz
  516.     call    show
  517.     call    .blk
  518.     mvi    a,'('
  519.     call    .couta
  520.     call    inout;        hl := input; de := output rcds
  521.     xchg
  522.     call    .dcmp;        flags on hl-de
  523.     xchg
  524.     cnc    chksav;        not smaller
  525.     jnc    crnch8;        not saved, de has message ptr.
  526.     call    dvd8hl;        rounding up
  527.     call    .tdzs;        input kbytes
  528.     xchg
  529.     lxi    d,ktok
  530.     call    tstr
  531.     call    dvd8hl
  532.     call    .tdzs;        output kbytes
  533.     lxi    d,kend
  534. crnch8:    call    tstr
  535.     xra    a;        no error
  536.     ret
  537. ;
  538. ktok:    db    'k --> $'
  539. kend:    db    'k)',cr,lf,'$'
  540. nosave:    db    'Not smaller, not saved)',cr,lf,'$'
  541. ;
  542. ; Check for save of output file.  Forced to no save here
  543. ; Set carry if file to be saved.
  544. ; Reset carry if file purged, when de is message pointer.
  545. ; a,f (de if no save only)
  546. chksav:    call    delout
  547.     ora    a
  548.     lxi    d,nosave
  549.     ret
  550.  
  551. ; setup input/output file names in fcbin/fcbout, using the globals
  552. ; fnptr, tfcb.  Carry if unable to create a suitable file name.
  553. ; a,f,b,c,d,e,h,l
  554. setfiles:
  555.     lxi    d,fcbin
  556.     lhld    fnptr
  557.     call    .nxtfn;        load the next file name
  558.     lxi    d,16
  559.     dad    d
  560.     shld    fnptr;        advance source name pointer
  561.     lxi    d,fcbout;    setup fcbout by
  562.     lxi    h,tfcb;         copying template
  563.     lxi    b,fcbin;     and replacing wild loc'ns
  564.     call    .nxtout
  565.     lda    outspec
  566.     ora    a
  567.     rnz;            file specified
  568. ;    "    "
  569. ; Now modify the output file type
  570.     lxi    h,fcbout+9
  571.     mov    a,m
  572.     cpi    ' '
  573.     jz    setf1;        no extension, make it YYY
  574.     inx    h
  575.     mov    a,m
  576.     cpi    'Y'
  577.     jnz    setf2;        Revised file type to xYx
  578.     mvi    m,'Y'
  579.     inx    h
  580.     mov    a,m
  581.     cpi    'Y'
  582.     jnz    setf2;        xYY does it
  583.     mvi    m,'Y'
  584.     dcx    h
  585.     dcx    h
  586.     mov    a,m
  587.     cpi    'Y'
  588.     jnz    setf2;        YYY does it
  589.     stc
  590.     ret;            Can't rename this file
  591. setf1:    mvi    m,'Y'
  592.     inx    h
  593.     mvi    m,'Y'
  594.     inx    h
  595. setf2:    mvi    m,'Y'
  596.     ora    a;        clear any carry
  597.     ret    
  598. ;
  599. ; show file to be transferred
  600. ; a,f,b,c,d,e,h,l
  601. showf:    lda    quiet
  602.     ora    a
  603.     cnz    .crlf
  604.     lda    inuser
  605.     dcr    a;        to cpm usage
  606.     lxi    d,fcbin
  607.     call    .tfnam;        input file id
  608.     lxi    d,xfrtomsg
  609.     call    tstr;        '==>'
  610.     lda    outuser
  611.     dcr    a;        to cpm usage
  612.     lxi    d,fcbout
  613.     call    .tfnam;        output file id
  614. ;    "    "
  615. ; Check for user abort
  616. ; a,f
  617. ckabt:    mvi    a,csta
  618.     call    .dos
  619.     rz;            no console interrupt
  620.     mvi    a,cin
  621.     call    .dos
  622.     cpi    3
  623.     mvi    a,xusrabt
  624.     jz    exeunt;        user abort
  625.     ret
  626. ;
  627. xfrtomsg:    db    ' ==> $'
  628. ;
  629. ; check fcbs de^ and hl^ are different names, else zero flag
  630. ; a,f
  631. cmpfns:    push    b
  632.     push    d
  633.     push    h
  634.     dcx    h;        pre-decrement
  635.     dcx    d
  636.     mvi    b,12;        names and drive ids
  637. cmpfn1:    inx    h
  638.     inx    d
  639.     ldax    d
  640.     xra    m
  641.     ani    07fh;        ignore attributes
  642.     jnz    cmpfn2
  643.     dcr    b
  644.     jnz    cmpfn1
  645. cmpfn2:    pop    h
  646.     pop    d
  647.     pop    b
  648.     ret
  649. ;
  650. ; Make a standard crunched file header
  651. header:    mvi    a,crnchid shr 8
  652.     ora    a;        set nz, no display yet
  653.     call    outbyt
  654.     mvi    a,crnchid AND 0ffh
  655.     ora    a;        set nz, no display yet
  656.     call    outbyt
  657.     lxi    h,3;        2 already, 0 byte coming
  658.     xchg
  659.     lxi    h,fcbin
  660.     call    outnm;        mark the source file id
  661.     lxi    h,stamp
  662.     call    outstg;        emit the user stamp
  663.     xchg
  664.     shld    xtraout;    save string size etc.
  665.     ori    0ffh;        reset z flag
  666.     mvi    a,0;        emit the 0 string terminator
  667. ;    "    "
  668. ; output a to buffered output file.  Savesp initialized. 
  669. ; Input Z flag triggers display mechanism.  CRN module linkage
  670. ; a,f,c
  671. plzhen:
  672.     push    psw;        save
  673.     push    h
  674.     lhld    outcnt
  675.     inx    h
  676.     shld    outcnt
  677.     mov    a,h
  678.     ora    l
  679.     jnz    obm1
  680.     lhld    outcnt+2
  681.     inx    h
  682.     shld    outcnt+2
  683. obm1:    pop    h;        restore
  684.     pop    psw
  685. outbyt:    mov    c,a
  686.     push    h
  687.     cz    show;        display statistics etc.
  688.     lhld    @outbuff
  689.     call    .bfputc
  690.     pop    h
  691.     rnc;            no error
  692.     lhld    savesp
  693.     sphl
  694.     mvi    a,xwrterr
  695.     jmp    exeunt;        i/o error
  696. ;
  697. ; Linkage for crn module
  698. ; a,f,h,l
  699. glzhen:
  700.     push    psw;        Save it
  701.     lhld    incnt
  702.     inx    h
  703.     shld    incnt
  704.     mov    a,h
  705.     ora    l
  706.     jnz    glzhcr
  707.     lhld    incnt+2
  708.     inx    h
  709.     shld    incnt+2
  710. glzhcr:    pop    psw;        Restore it
  711. getchr:    lhld    @inbuff
  712.     call    .bfgetc;    get a byte.  Carry for eof.
  713.     rc;            no checksum update at eof
  714.     lhld    cksum
  715.     push    psw
  716.     add    l
  717.     mov    l,a
  718.     adc    h
  719.     sub    l
  720.     mov    h,a
  721.     shld    cksum
  722.     pop    psw
  723.     ret
  724. ;
  725. ; Output string hl^ until 0 byte. Countem in de
  726. ; a,f,c,h,l
  727. outstg:    mov    a,m
  728.     ora    a
  729.     rz
  730.     inx    d;        count chars
  731.     call    outbyt;        nz flag, will not trip display
  732.     inx    h
  733.     jmp    outstg
  734. ;
  735. ; Output file name hl^.  Full blank fill the type field
  736. outnm:    push    b
  737.     mvi    b,8;        max chars in file name
  738.     push    h;        save start point
  739. outnm1:    inx    h
  740.     mov    a,m
  741.     inx    d;        count chars emitted
  742.     cpi    ' '
  743.     jz    outnm2;        done file name
  744.     call    outbyt;        nz, no display trip
  745.     dcr    b
  746.     jnz    outnm1
  747.     inx    d;        for coming '.'
  748. outnm2:    mvi    a,'.'
  749.     ora    a;        nz, prevent display
  750.     call    outbyt
  751.     pop    h;        get start point back
  752.     lxi    b,8;        point to type field
  753.     dad    b
  754.     mvi    b,3
  755. outnm3:    inx    h
  756.     mov    a,m
  757.     inx    d
  758.     ora    a;        nz, prevent display
  759.     call    outbyt
  760.     dcr    b
  761.     jnz    outnm3
  762.     pop    b
  763.     ret
  764. ;
  765. ; Get input/output records to hl, de respectively
  766. ; a,f,d,e,h,l
  767. inout:    lhld    incnt+1;    LS byte is zero
  768.     dad    h;        double, in records
  769.     lda    incnt
  770.     add    a
  771.     jnc    inout1;        not an extra record
  772.     inx    h
  773. inout1:    adi    252;        2 * (127-1). EOF was counted at end.
  774.     jnc    inout2;        no partial record to round up
  775.     inx    h
  776. inout2:    push    h
  777.     lhld    outcnt;        only useful at end
  778.     mvi    h,0
  779.     xchg
  780.     lhld    xtraout
  781.     dad    d
  782.     lxi    d,127;        round up to records
  783.     dad    d
  784.     dad    h;        double, records to h
  785.     mov    a,h;        additional
  786.     lhld    outcnt+1;    LS byte is zero
  787.     dad    h;        double, to records
  788.     add    l
  789.     mov    l,a;        + the extra bits
  790.     adc    h
  791.     sub    l
  792.     mov    h,a;        form records emitted (rounded up)
  793.     xchg
  794.     pop    h
  795.     ret
  796. ;
  797. ; Show any statistics etc.
  798. ; a,f,h,l
  799. show:    call    ckabt;        check for user abort
  800.     lda    quiet
  801.     ora    a
  802.     rz;            in quiet mode
  803.     push    b
  804.     push    d
  805.     mvi    a,cr
  806.     call    .couta
  807.     call    inout;        get input/output records
  808.     call    tdzs6f;        show input records
  809.     push    h
  810.     xchg
  811.     call    tdzs6f;        show output records
  812.     xchg
  813.     lxi    b,200;        for rounding
  814.     call    .imul;        dehl := de*bc
  815.     pop    b
  816.     call    .idiv;        de := dehl/bc = input/output*200
  817.     xchg
  818.     inx    h;        round result
  819.     call    dvd2hl;        divide / 2 (for 200 above)
  820.     mvi    a,5
  821.     call    .tdzsf
  822.     mvi    a,'%'
  823.     call    .couta
  824.     lhld    nxtcod
  825.     call    tdzs6f
  826.     lhld    ttotal
  827.     call    tdzs6f
  828.     pop    d
  829.     pop    b
  830.     ret
  831. ;
  832. ; Shift hl right 3 (divide by 8), rounding up
  833. ; a,f,h,l
  834. dvd8hl:    push    d
  835.     lxi    d,7
  836.     dad    d
  837.     pop    d
  838.     call    dvd2hl
  839.     call    dvd2hl
  840. ;    "    "
  841. ; Shift hl right 1.  RH bit to carry
  842. ; a,f,h,l
  843. dvd2hl:    mov    a,h
  844.     ora    a
  845.     rar
  846.     mov    h,a
  847.     mov    a,l
  848.     rar
  849.     mov    l,a
  850.     ret
  851. ;
  852. ; Write hl (dec) in 6 char. field. with at least 1 leading blank
  853. ; a,f
  854. tdzs6f:    mvi    a,6
  855.     jmp    .tdzsf
  856. ;
  857. ; Parse the command tail into the stamp buffer
  858. ; a,f,b,d,e,h,l
  859. rstamp:    lxi    h,stamp
  860.     call    .skipblks
  861.     rc;            EOL, no tail
  862.     cpi    '['
  863.     rnz;            not a valid marker
  864.     mvi    b,stpmax-1
  865. rstp1:    dcr    b
  866.     jz    rstp2;        max storage used
  867.     mov    m,a
  868.     inx    h
  869.     cpi    ']'
  870.     jz    rstp3
  871.     inx    d;        (CCP+ can allow lc command tails)
  872.     ldax    d;        not .nextch, don't upshift
  873.     cpi    ' '
  874.     jnc    rstp1
  875. rstp2:    mvi    m,']';        jam in the missing ']'
  876.     inx    h
  877. rstp3:    mvi    m,0;        default EOL
  878.     ret
  879. ;
  880. ; Lock the user # (0 means default) to an absolute value.
  881. ; Returns in range 1..maxuser, and cpm calls use this -1.
  882. ; This is because the buffer system can record "default user"
  883. ; as distinct from "specified user".
  884. ; a,f
  885. usrlok:    call    .xltusr;    now range 0..maxuser
  886.     inr    a;        now 0 is forbidden.
  887.     ret
  888. ;
  889.         dseg;    LINK AFTER all code areas
  890. incnt:        ds    4;    Input count
  891. outcnt:        ds    4;    Output count
  892. nxtcod:        ds    2;    Needed by display stuff
  893. ttotal:        ds    2;    Needed by display stuff
  894. options:    ds    2;    Standard header
  895. confirm:    ds    1;    Flog for confirmation per file
  896. keepem:        ds    1;    Flag to keep old files
  897. purge:        ds    1;    Flag for copy verification
  898. quiet:        ds    1;    flag for quiet operation
  899.     if    ($-options)-2 ne optlgh
  900.      +++ Error in option storage assignment +++
  901.     endif
  902. ;
  903. entryusr:    ds    1;    User in effect at startup
  904. outspec:    ds    1;    non-zero if output file specified
  905. ;
  906. ; inuser/outuser are 0 for current user, user+1 if specified
  907. inuser:        ds    1;    User # for fcbin
  908. outuser:    ds    1;    User # for fcbout
  909. ;
  910. fcbin:        ds    36;    Input fcb
  911. fcbout:        ds    36;    Output fcb
  912. bufsize:    ds    2;    space available for outbuff
  913. @inbuff:    ds    2;    pointer to input buffer, 2 * bufsize
  914. @outbuff:    ds    2;    pointer to output buffer, 1 * bufsize
  915. @freemem:    ds    2;    pointer to available memory
  916. cksum:        ds    2;    for checksum accumulation
  917. filesdone:    ds    2;    count of files processed
  918. fncount:    ds    2;    count of files to process
  919. fnptr:        ds    2;    pointer to NEXT file to process
  920. savesp:        ds    2;    for aborts during writes
  921. xtraout:    ds    2;    keep track of overhead bytes added
  922. stamp:        ds    stpmax;    User entered stamp
  923.         end
  924.