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