home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug167.arc / CL10.LBR / CL10.ZZ0 / CL10.Z80
Text File  |  1991-05-07  |  42KB  |  1,833 lines
  1. ;Program:    CL (Compact Library)
  2. ;Authors:    Michal Carson and Bruce Morgen
  3. ;Version:    1.0
  4. ;Date:        May 7, 1991
  5. ;Purpose:    This utility has one purpose: to compact a
  6. ;        library.  It is invoked by the command "CL
  7. ;        filename" in which "filename" is  assumed to
  8. ;        have the extension LBR.  CL compresses the
  9. ;        library, overwriting deleted entries and
  10. ;        other unused sectors of the LBR file with
  11. ;        active members.  CL then de-allocates the
  12. ;        remaining blocks and/or extents of the LBR
  13. ;        file.  This method may not be compatible with
  14. ;        all systems, so caution is advised.  CL does
  15. ;        not create a new library.  It overwrites the
  16. ;        existing library.
  17.  
  18. ; v1.0   April 27 - May 7, 1991  Bruce Morgen
  19. ; Release version, eliminated warm boot when an RSX is detected,
  20. ; fixed a stack imbalance bug when zero-length member files are
  21. ; present (reported by Terry Hazen - thanks!)  Saved a few bytes
  22. ; through more double register SBC!ADD sequences as per Joe
  23. ; Wright via Howard Goldstein, shortened DosDisk test.
  24.  
  25. ; v0.09  April 19, 1991  Bruce Morgen
  26. ; Added "-afn,afn,afn" delete member function.  File is compacted
  27. ; in this mode to avoid weird "ghost" spaces unless the deleted
  28. ; members were all zero-length.
  29.  
  30. ; v0.08  April 18, 1991  Bruce Morgen
  31. ; If there is no "waste" and the "Z" option is selected, no compact
  32. ; is done, but the LBR's directory is sorted and rewritten as
  33. ; suggested by Bob Dean.  LBR's active, deleted, and open member
  34. ; statistics are displayed as suggested by Terry Hazen.  Deleted
  35. ; FRESET inclusion in favor of linked module and external.
  36.  
  37. ; v0.07  ??????
  38.  
  39. ; v0.06  October 23, 1990  Bruce Morgen
  40. ; LBR directory now sorted.  Suggested by Bob Dean.
  41.  
  42. ; v0.05  October 20, 1990  Bruce Morgen
  43. ; Z80 and CP/M 2.2 tests performed earlier, stack-hungry
  44. ; EPRINT not called until local stack established.  Suggested
  45. ; by Howard Goldstein.
  46.  
  47. ; v0.04  October 19, 1990  Bruce Morgen
  48. ; Fixed nasty problem caused by Michal's assumption that DS 
  49. ; directives zero-fill.  When CL's buffers were put in DSEG,
  50. ; CL would unpredictably hang the system.  Used the brute force
  51. ; solution of zero-filling the entire buffer space immediately.
  52. ; This has the added benefit of making CL re-executable via GO.
  53. ; Somehow stayed within 25 records through dogged code-cutting.
  54.  
  55. ; v0.03  October 17, 1990  Bruce Morgen
  56. ; This puppy has been around for a year and a half with no public
  57. ; comment that I can recall seeing.  Personally, I think it's
  58. ; Michal's finest hour -- a fine utility.  I have taken the liberty
  59. ; of spiffing it up a bit.  The size of CL.COM has been reduced by
  60. ; four records, mostly though use of DSEG and an appropriate linker.
  61. ; PROLINK is a wonderful tool, but it is strictly one-pass and
  62. ; cannot do that job.  Michal's assumption about ZPRSFN working in
  63. ; a non-Z3 environment is simply not true.  CL would have to include
  64. ; an internal environment descriptor for ZPRSFN (and GETCCP or 
  65. ; GETZRUN, for that matter) to work predictably.  I could have done
  66. ; this, but since CL does not need to parse the command line under
  67. ; Z-System, I simulated ZPRSFN using SYSLIB's FNAME instead.  The
  68. ; other somewhat significant change is the use of SYSLIB's table-
  69. ; driven CRC routines, which results in a modest-but-measurable
  70. ; increase in speed.  I was able to knock off a few bytes of code 
  71. ; here and there, but CL is quite well-crafted and shortening it any
  72. ; further would take more effort than is sensible (at least for me).
  73. ; Last and certainly least, CL now displays the DU: of the LBR being
  74. ; analyzed and/or processed.
  75.  
  76. ; v0.02  04/09/89  Michal Carson
  77. ; Howard Goldstein again diagnosed errors in the utility.  A minor
  78. ; change concerns the location of the first token by the parsing
  79. ; routine (zprsfn).  More importantly, I had commented out code which
  80. ; loaded the address of the sector translation table into DE before
  81. ; the call to the BIOS.  Also important, I was resetting the low bit
  82. ; of E before the call to SETDSK when I should have been setting it.
  83. ; Resetting tells the BIOS that the disk has not been accessed
  84. ; previously, while setting indicates that the disk has been used.
  85. ; Found that I was misusing @fncmp (inserted from syslib for the last
  86. ; revision in place of my own routine) and consequently the program
  87. ; failed to find some directory entries for the library.  Converted
  88. ; fully to syslib for all the routines which may be found there.
  89.  
  90. ; v0.01  03/17/89  Michal Carson
  91. ; Changes to this beta version of the utility come as a result of
  92. ; input from Howard Goldstein and Bridger Mitchell (Bridger
  93. ; supplied a nice long list of enhancements).  I was able to 
  94. ; incorporate all but a few of their reccommendations; still have
  95. ; some questions about the obscure disk formats.  Most changes
  96. ; aim to ensure predictable performance under varying systems.
  97. ; I think CL has come up to standards there.  The utility now
  98. ; insists on a Z80 and a BDOS which returns 2.2 as version number.
  99. ; CP/M+ and Z3PLUS are not supported; this will come later
  100.  
  101.     title    Compact Library
  102.  
  103.     extrn    freset                ;freset10
  104.     extrn    dump                ;rdump
  105.     extrn    sort                ;mysort
  106.  
  107.     extrn    z3init,getccp,getzrun,getefcb    ;z3lib    
  108.     extrn    puter2                ;  "
  109.  
  110.     extrn    f$open,f$close            ;syslib
  111.     extrn    r$read,r$write,setdma
  112.     extrn    sksp,fname,@fncmp,@afncmp,divhd
  113.     extrn    eprint,phldc,pafdc,phlfdc,pfn2,cout
  114.     extrn    crc3init,crc3clr,crc3upd,crc3done
  115.  
  116.     public    $memry
  117.  
  118. version    equ    10    ;increments on changes to CL
  119.  
  120. cuss    equ    07h
  121. bs    equ    08h
  122. cr    equ    0dh
  123. lf    equ    0ah
  124. space    equ    020h
  125. fcb1    equ    05ch    ;address of cpm default fcb
  126. tbuff    equ    080h    ;address of command tail buffer
  127. entsize    equ    31    ;11 bytes for filename.typ
  128.             ;4 bytes for index and length of member
  129.             ;2 bytes for crc-16
  130.             ;8 bytes for time and date stamps
  131.             ;1 byte for padbyte count
  132.             ;5 bytes for disk use
  133.  
  134. entry:    jp    start
  135.     db    'Z3ENV'
  136.     db    1
  137. z3eadr:    dw    0000h        ; Leave this alone!
  138.     db    version
  139. $memry:    dw    0000h
  140.  
  141. noz80:    db    cuss,'Must have a Z80$'
  142. nocpm:    db    cuss,'Must have CP/M 2.2$'
  143.  
  144. start:    ld    de,noz80
  145.     ld    c,9
  146.     sub    a        ;check for Z80 processor
  147.     jp    pe,5        ;we don't have it, inform and exit
  148.     ld    c,0ch        ;check system version
  149.     call    5
  150.     ld    de,nocpm
  151.     ld    c,9
  152.     ld    a,l
  153.     sub    22h        ;must be CP/M 2.2 compatible
  154.     jp    nz,5        ;cannot operate, inform and exit
  155.  
  156.     ld    hl,dsbegn    ;Zero out the entire DSEG because
  157.     ld    de,dsbegn+1    ;we don't know which bytes have
  158.     ld    bc,dslen    ;to be zero for CL to work.
  159.     ld    (hl),a        ;A = 0 from "sub 22h" above
  160.     ldir
  161.  
  162.     ld    hl,(z3eadr)    ;got Z3 environment?
  163.     ld    a,l
  164.     or    h        ;test
  165.     ld    (z3flag),a    ;& store
  166.     jr    nz,z3ccp
  167.     ld    hl,(1)        ;get BIOS warm boot
  168.     ld    de,-1603h    ;offset to 2K CCP
  169.     add    hl,de        ;compute CCP address
  170.     jr    cpmccp
  171.  
  172. z3ccp:    call    z3init        ;Z3LIB's wake-up call....
  173.     call    getccp        ;CCP address into HL
  174. cpmccp:    ld    de,(6)        ;bdos address into DE
  175.     xor    a        ;assure carry cleared
  176.     sbc    hl,de        ;find the lower address
  177.     ex    de,hl        ;use the bdos address if NC
  178.     jr    nc,setstk    ;carry if no RSX present
  179.     add    hl,de        ;so restore HL to CCP address
  180. setstk:
  181.     ld    (stack),sp    ;save stack ptr
  182.     ld    sp,hl        ;set stack at top of memory
  183.     dec    h        ;100h grace for stack
  184.     ld    (tpaend),hl    ;save as end of copy buffer
  185.     ld    hl,($memry)    ;ptr to end of code
  186.     call    crc3init    ;create CRC table, HL preserved
  187.     inc    h        ;table needs 512 bytes
  188.     inc    h
  189.     ld    (list),hl    ;initialize base ptr for list
  190.  
  191.     call    signon        ;tell 'em who we are
  192.     ld    a,(fcb1+17)    ;first character of second token
  193.     cp    '-'
  194.     call    z,delini
  195.     sub    '?'        ;subtract 3fh
  196.     ld    (inquiry),a    ;'?' causes exit after free space display
  197.     sub    1bh        ;subtract as though 'Z'
  198.     ld    (override),a    ;'Z' forces compact
  199.  
  200.     call    getdsk        ;save currently selected drive
  201.     ld    (disk),a
  202.     call    getusr        ;set up a default for exit
  203.     call    savusr        ;save current, recall with retusr
  204.  
  205.     ld    hl,(fcb1+1)    ;look for help request
  206.     ld    de,'//'        ;signified by two slashes
  207.     xor    a        ;clear carry
  208.     ld    a,l        ;save byte a fcb+1 in A
  209.     sbc    hl,de        ;check for help query
  210.     jr    z,jzhlp        ;jump if found
  211.     cp    space+1        ;test for filename from command line
  212.     jr    c,jnzhlp    ;no filename given
  213.  
  214. ; Re-parse command line so that du: references will be resolved on
  215. ; (why?) non-ZCPR systems.
  216.  
  217. start1:
  218.     ld    de,fcb1        ;ptr to fcb
  219.     ld    a,(z3flag)
  220.     or    a
  221.     jr    nz,start1z
  222.     ld    hl,tbuff+1    ;ptr to command tail
  223.     call    sksp        ;find token
  224.     call    parse        ;WILL work on any system
  225. jnzhlp:
  226.     jp    nz,help        ;failed parse, no fair
  227.  
  228. start1z:
  229.     ld    h,d        ;check FCB at DE for ambiguity
  230.     ld    l,e
  231.     ld    bc,12
  232.     ld    a,'?'
  233.     cpir
  234. jzhlp:
  235.     jp    z,help        ;ambiguity prohibited, educate
  236.  
  237.     call    openlbr        ;find and open the library
  238.     jp    c,exit1        ;can't find it or form is bad
  239.  
  240.     call    justify        ;evaluate need for compression
  241.     push    af        ;save result flag
  242.  
  243.     ld    hl,(waste)    ;free space
  244.     ld    a,l
  245.     or    h
  246.     ld    (justfl),a    ;save as byte flag
  247.     call    phlfdc        ;print the number
  248.     call    eprint
  249.     db    ' records of free space in ',0
  250.     call    lpfn        ;show the file name
  251.  
  252.     call    happy2        ;print xxxxxK
  253.     ld    b,3+6
  254.     ld    a,space        ;print 3 more spaces
  255.     call    cout        ;and 6 to allow for backspaces
  256.     djnz    $-3
  257.  
  258.     pop    af        ;result from justify:
  259.     jr    c,start2    ;proceed if justified
  260.  
  261.     ld    a,(override)    ;or if overridden by command line
  262.     or    a
  263.     jr    nz,exit2    ;no override instruction
  264.  
  265. start2:
  266.     ld    a,(inquiry)    ;did they only want to see space?
  267.     or    a
  268.     jr    z,exit2        ;yes, so they've seen, so exit
  269.  
  270.     ld    a,(fcb1)    ;get disk select
  271.     dec    a        ;0=A:
  272.     push    af        ;save disk
  273.     call    freset        ;reset before we start
  274.  
  275.     ld    a,(justfl)
  276.     or    a
  277.     push    af
  278.     call    nz,compact    ;do the damage
  279.     call    closlbr
  280.     pop    af
  281.     call    nz,truncate    ;do even more damage
  282.     pop    af        ;get disk select
  283.     call    freset        ;disk reset again (bdos function 37)
  284.     xor    a
  285.     jr    exit
  286.  
  287. abort:
  288.     call    lpfn        ;show file name
  289.     call    eprint
  290.     db    cuss,' is too large to handle.'
  291.     ld    a,1
  292.     jr    exit
  293.  
  294. exit1:
  295.     call    eprint
  296.     db    'Error opening ',0
  297.     call    lpfn        ;show file name
  298.     ld    a,2
  299.     jr    exit
  300.  
  301. exit2:
  302.     call    eprint
  303.     db    bs,bs,bs,'not compacted',0
  304.     xor    a
  305.     
  306. exit:
  307.     ld    hl,z3flag
  308.     inc    (hl)
  309.     dec    (hl)
  310.     call    nz,puter2
  311.     push    af
  312.     ld    a,(justfl)
  313.     ld    hl,override
  314.     or    (hl)
  315.     jr    nz,exit3
  316.     call    eprint
  317.     db    bs,bs,bs,'sorted & checked',0
  318. exit3:    ld    a,(disk)    ;get entry disk
  319.     call    setdsk        ;and re-select
  320.     call    retusr        ;set original user area
  321.     pop    af
  322.     or    a
  323.     jr    nz,exith
  324.  
  325.     call    eprint
  326.     db    cr,lf,'Contents: ',0
  327.     ld    hl,(cntact)
  328.     ld    a,l
  329.     or    h
  330.     jr    z,exit4
  331.     dec    hl
  332. exit4:    call    prnmbr
  333.     call    eprint
  334.     db    ' active member',0
  335.     scf
  336.     call    plural
  337.     ld    hl,(cntdel)
  338.     call    prnmbr
  339.     call    eprint
  340.     db    ' deleted member',0
  341.     scf
  342.     call    plural
  343.     ld    hl,(cntopn)
  344.     call    prnmbr
  345.     call    eprint
  346.     db    ' open member slot',0
  347.     or    a
  348.     call    plural
  349.  
  350. exith:    ld    sp,(stack)    ;set original stack location
  351.     ret            ;return to ccp
  352.  
  353.  
  354.     subttl    identification message and command syntax
  355.  
  356. ; No mystery here.  Say who is doing this.  If ZEX is running, it
  357. ; probably means CL was invoked by a ZFiler macro, in which case
  358. ; it would be neater not to print the banner every time.
  359.  
  360. signon:
  361.     ld    a,(z3flag)    ;non-zero of Z3 running
  362.     or    a        ;non-Z3 systems don't have ZEX
  363.     call    nz,getzrun    ;any ZEXual activity?
  364.     ret    nz        ;skip the signon message
  365.     call    eprint
  366.     db    'CL (Compact Library), Version '
  367.     db    version/10+'0','.',version mod 10+'0'
  368.     db    cr,lf,0
  369.     ret
  370.  
  371. ; Help the user with command syntax
  372.  
  373. help:
  374.     call    eprint
  375.     db    'Syntax:',cr,lf,0
  376.     call    clfnam
  377.     ld    b,19
  378.     ld    a,space
  379.     call    cout
  380.     djnz    $-3
  381.     call    eprint
  382.     db    'compact filename',cr,lf,0
  383.     call    clfnam
  384.     ld    a,'?'
  385.     call    cout
  386.     ld    b,18
  387.     ld    a,space
  388.     call    cout
  389.     djnz    $-3
  390.     call    eprint
  391.     db    'report free space',cr,lf,0
  392.     call    clfnam
  393.     ld    a,'Z'
  394.     call    cout
  395.     ld    b,18
  396.     ld    a,space
  397.     call    cout
  398.     djnz    $-3
  399.     call    eprint
  400.     db    'force compact',cr,lf,0
  401.     call    clfnam
  402.     call    eprint
  403.     db    '-afn1[,afn2,...]   delete members',0
  404.  
  405.     jp    exith
  406.  
  407. clfnam:
  408.     call    eprint
  409.     db    '   ',0
  410.     ld    a,(z3flag)
  411.     or    a
  412.     call    nz,getefcb
  413.     jr    nz,gotefcb
  414.     ld    hl,clname-1
  415. gotefcb:
  416.     ld    b,8
  417. namelp:    inc    hl
  418.     ld    a,(hl)
  419.     and    7fh
  420.     cp    space
  421.     call    nz,cout
  422.     djnz    namelp
  423.     call    eprint
  424.     db    ' [DU:]filename[.LBR] ',0
  425.     ret
  426.  
  427. clname:    db    'CL      ',0
  428.  
  429.  
  430.     subttl    environmental check for operating reqirements
  431.  
  432. ; Check disk format to determine if
  433. ; CL can operate successfully.  Return C if we must exit.
  434.  
  435. ; This entry point is called from OPENLBR after the file control
  436. ; block has been initialized.  If the file is on DosDisk, the
  437. ; word at fcb+16 is 0fdfdh.
  438.  
  439. environ2:
  440.     ld    hl,(fcb1+16)    ;check for DosDisk files
  441.     ld    bc,0fdfdh    ;after file is open
  442.     or    a
  443.     sbc    hl,bc
  444.     jr    nz,environ3    ;not DosDisk signature
  445.     call    eprint
  446.     db    cuss,' file is on DosDisk',0
  447.     scf
  448.     ret
  449. environ3:
  450.     or    a        ;clear carry
  451.     ret            ;file is not on DosDisk
  452.  
  453.  
  454.     subttl    perform the compression
  455.  
  456. ; Read first physical member until buffer full or end of member; 
  457. ; record the number of sectors read and the current position 
  458. ; within the file.  Beginning after the directory (directory is 
  459. ; not compressed), write out the same number of sectors; accumulate
  460. ; number of sectors written in RETAIN.
  461.  
  462.  
  463. compact:
  464.     ld    ix,(list)    ;ptr to list entry
  465.  
  466. compact1:
  467.     push    ix
  468.     pop    bc        ;ptr to list entry
  469.     ld    hl,12        ;offset to offset high byte
  470.     add    hl,bc        ;HL ptr to offset high byte
  471.  
  472.     ld    b,(hl)
  473.     dec    hl
  474.     ld    c,(hl)        ;BC offset to member
  475.     push    bc        ;push offset to member
  476.     ld    bc,(retain)    ;get current write ptr
  477.     ld    (hl),c        ;replace the one in the list
  478.     inc    hl
  479.     ld    (hl),b
  480.  
  481.     inc    hl        ;ptr to length
  482.     ld    c,(hl)
  483.     inc    hl
  484.     ld    b,(hl)        ;BC length of member
  485.  
  486.     ld    a,b
  487.     or    c        ;check for zero length member
  488.     jr    z,compact0    ;move to next entry
  489.  
  490. compact6:
  491.     ld    hl,(bptr)    ;HL ptr buffer
  492.     call    setdma
  493.     ex    de,hl        ;DE current DMA
  494.     pop    hl        ;HL offset to member
  495.  
  496. compact2:
  497.     push    de        ;save DMA
  498.     ld    de,fcb1
  499.     call    r$read        ;read random sector HL
  500.     pop    de
  501.  
  502.     push    hl
  503.     ld    hl,(bcnt)    ;count of sectors in buffer
  504.     inc    hl
  505.     ld    (bcnt),hl    ;add one and save
  506.     pop    hl
  507.  
  508.     inc    hl        ;next sector next round
  509.     dec    bc        ;or was that the end?
  510.     ld    a,b
  511.     or    c
  512.     jr    z,compact3    ;end of member, exit
  513.  
  514.     push    hl
  515.     ld    hl,080h        ;move DMA up one record
  516.     add    hl,de
  517.     call    setdma        ;set DMA from HL
  518.     ex    de,hl        ;hold DMA in DE
  519.  
  520.     ld    hl,(tpaend)    ;get top of buffer
  521.     or    a        ;clear carry
  522.     sbc    hl,de        ;are we there yet?
  523.     pop    hl        ;get random record number
  524.     jr    nc,compact2    ;not at tpa end yet, keep reading
  525.  
  526. ; Reached end of member or end of buffer
  527.  
  528. compact3:
  529.     ld    (offset),hl    ;store record counter
  530.     ld    (length),bc    ;store remaining length
  531.  
  532.     ld    bc,(bcnt)    ;records in buffer
  533.     ld    hl,(bptr)    ;base of buffer
  534.     call    setdma        ;set DMA from HL
  535.     ex    de,hl        ;current DMA into DE
  536.     ld    hl,(retain)    ;write offset into lbr
  537.  
  538. ;Write the buffer over current data
  539.  
  540. compact4:
  541.     push    de        ;save DMA
  542.     ld    de,fcb1
  543.     call    r$write        ;write record number in HL
  544.     pop    de
  545.  
  546.     inc    hl        ;next record
  547.     ld    a,h
  548.     or    l        ;check for rollover
  549.     jp    z,abort        ;will have aborted in justify:
  550.                 ;this check is redundant
  551.  
  552.     dec    bc        ;more records in buffer?
  553.     ld    a,b
  554.     or    c
  555.     jr    z,compact5    ;buffer empty, reload
  556.  
  557.     push    hl        ;save record counter
  558.     ld    hl,080h        ;move DMA
  559.     add    hl,de
  560.     call    setdma        ;set DMA from HL
  561.     ex    de,hl        ;save current DMA in DE
  562.     pop    hl        ;get record number
  563.  
  564.     jr    compact4    ;write the next record
  565.  
  566. ; Buffer empty; save counters and reload
  567.  
  568. compact5:
  569.     ld    (bcnt),bc    ;re-initialize (bc is zero)
  570.     ld    (retain),hl    ;save sectors written
  571.  
  572.     call    happy        ;keep the user entertained
  573.  
  574.     ld    hl,(offset)    ;read ptr
  575.     ld    bc,(length)    ;remaining length
  576.     push    hl        ;needed on stack at compact6
  577.     ld    a,b
  578.     or    c        ;unless zero
  579.     jr    nz,compact6    ;continue with present member
  580. compact0:
  581.     pop    hl        ;clear stack
  582.  
  583. compact7:
  584.     ld    de,entsize    ;advance to next list entry
  585.     add    ix,de
  586.     ld    a,(ix+0)    ;check for list terminator
  587.     or    a
  588.     jp    nz,compact1    ;start again with next member
  589.  
  590.     ret            ;NC is no error
  591.  
  592.  
  593.     subttl    de-allocate unused sectors from file
  594.  
  595. ; Read the entire directory doing our own searches for entries
  596. ; matching the file we compressed.  Calculate the filesize
  597. ; represented by each directory entry, delete those we no longer
  598. ; need (e5), and adjust the one entry which overlaps what we wish
  599. ; to keep and what we don't.
  600.  
  601. truncate:
  602.     ld    hl,tbuff    ;get DMA under control
  603.     call    setdma
  604.  
  605.     ld    de,fcb1
  606.     call    f.first        ;get first occurance of our file
  607.     jr    z,truncat3    ;not found?
  608.  
  609. truncat1:
  610.     ld    d,0
  611.     ld    e,a        ;DE ptr to directory entry
  612.     push    de
  613.     pop    ix        ;IX ptr to directory entry
  614.  
  615.     ld    a,(ix+14)    ;s2
  616.     and    0fh        ;should be 03fh, but will overflow
  617.     rrca            ;at 8Meg
  618.     rrca
  619.     rrca
  620.     rrca            ;*2^4
  621.     ld    h,a
  622.  
  623.     ld    a,(ix+12)    ;ex
  624.     and    1fh
  625.     rrca            ;/2
  626.     ld    l,a        ;save in l
  627.     and    0fh        ;low 4 bits belong to h
  628.     or    h
  629.     ld    h,a
  630.     ld    a,l        ;recover from l
  631.     and    080h        ;final bit is for l
  632.     ld    l,a
  633.  
  634.     ld    a,(ix+15)    ;rc
  635.     push    af        ;save rc
  636.     and    7fh
  637.     or    l        ;stray records into l
  638.     ld    l,a        ;HL contains record count
  639.     pop    af        ;get rc
  640.  
  641.     ld    bc,80h
  642.     and    80h        ;check high bit of rc
  643.     jr    z,$+3
  644.     add    hl,bc        ;add another 80h sectors
  645.  
  646.     or    a
  647.     ld    bc,(retain)    ;count of records to retain
  648.     sbc    hl,bc        ;compare current to what we're seeking
  649.     add    hl,bc        ;restore HL
  650.     jr    c,truncat2    ;earlier extent than we want, keep it
  651.  
  652.     push    hl
  653.     ld    hl,(extent)    ;records in one extent
  654.     dec    hl        ;make a sort of extent mask
  655.     ld    a,l
  656.     or    c
  657.     ld    c,a        ;or HL with BC
  658.     ld    a,h
  659.     or    b
  660.     ld    b,a
  661.     inc    bc        ;BC is upper limit of extent we want
  662.     inc    bc        ;plus one
  663.     pop    hl        ;refresh HL
  664.     sbc    hl,bc        ;is HL still larger?
  665.     add    hl,bc        ;restore it
  666.     jp    c,release    ;here's the tricky part
  667.                 ;wherein we re-distribute blocks
  668.  
  669.     ex    de,hl        ;we delete this entry altogether
  670.     ld    (hl),0e5h    ;cp/m specified delete "user"
  671.     ex    de,hl
  672.  
  673. truncat4:
  674.     ld    hl,writef    ;set flag to re-write sector
  675.     inc    (hl)
  676.  
  677. truncat2:
  678.     ld    de,fcb1
  679.     call    f.next        ;find next entry
  680. truncat3:
  681.     jr    c,truncat5    ;non-recoverable error
  682.     jr    nz,truncat1    ;get next block directory
  683.     ret
  684.  
  685. ; The following is effected in the event of a bios read or
  686. ; write error.  We print or dump everything we have and hope
  687. ; the user can straighten things out.  Here's hoping this is
  688. ; wasted effort.
  689.  
  690. truncat5:
  691.     call    eprint        ;fess up
  692.     db    cuss,cr,lf
  693.     db    ' BIOS error!',cr,lf,space,0
  694.  
  695.     ld    a,(writef)    ;if this isn't reset yet
  696.     or    a        ;it was a write error
  697.     jr    nz,truncat6
  698.     call    eprint        ;else it was read error
  699.     db    'read',0
  700.     jr    truncat7
  701. truncat6:
  702.     call    eprint
  703.     db    'writ',0    ;bad bad
  704. truncat7:
  705.     call    eprint
  706.     db    'ing sector ',0
  707.     ld    hl,(sector)
  708.     call    phldc        ;print sector number
  709.  
  710.     call    eprint
  711.     db    ' of track ',0
  712.     ld    hl,(track)
  713.     ld    de,(off)
  714.     or    a
  715.     sbc    hl,de
  716.     call    phldc        ;print track number
  717.  
  718.     call    eprint
  719.     db    ' (physical track ',0
  720.     add    hl,de        ;restore physical track
  721.     call    phldc
  722.     call    eprint
  723.     db    ')',cr,lf,0
  724.  
  725.     ld    hl,tbuff    ;dump the directory sector
  726.     jp    dump        ;jp=call!ret
  727.  
  728.  
  729. ; Now release unneeded blocks.  Determine how many blocks to
  730. ; nop fill by subtracting the number of sectors to retain from
  731. ; the number represented in this directory entry (passed in HL),
  732. ; then "dividing" that figure by the disk block size.  First we
  733. ; ensure that HL is a multiple of the block size.
  734.  
  735. ; Blocks may require one byte or two bytes to designate.  The
  736. ; only clue we have/need is the high byte of the dsm; if that is
  737. ; non-zero, use two bytes.
  738.  
  739. ; On exit from this routine, calculate the new RC, EX, and S2.
  740.  
  741. release:
  742.     ld    a,(blm)        ;get block mask
  743.     ld    b,a        ;save
  744.     and    l        ;even already?
  745.     ld    a,b
  746.     jr    z,$+5        ;even block already, skip
  747.     or    l        ;combine with records in this entry
  748.     ld    l,a        ;back to HL
  749.     inc    hl        ;rounded up to next block
  750.  
  751.     xor    a        ;clear carry, clear accumulator
  752.     ld    bc,(retain)
  753.     sbc    hl,bc        ;HL contains records to delete
  754.  
  755.     ld    bc,(blksize)    ;how many of these do we dump?
  756. release1:
  757.     sbc    hl,bc        ;subtract one block
  758.     inc    a        ;increment block counter
  759.     jr    nc,release1
  760.  
  761.     dec    a        ;any blocks to remove?
  762.     jr    z,release3    ;no, just reset rc, ex, and s2
  763.     ld    b,a
  764.  
  765.     ld    a,(dsm+1)    ;high byte of bios' dsm
  766.     ld    c,a        ;keep this in c
  767.  
  768.     ld    hl,31        ;offset to last block number
  769.     add    hl,de        ;DE still fcb ptr
  770.     xor    a
  771.     ld    e,a        ;in case dsm is <256
  772. release2:
  773.     ld    d,(hl)        ;pick up block in DE, high byte
  774.     ld    (hl),0        ;zero out directory block number
  775.     dec    hl
  776.     ld    a,c        ;high byte of bios' dsm
  777.     or    a        ;check dsm
  778.     jr    z,$+6        ;only one byte per block
  779.     ld    e,(hl)        ;low byte
  780.     ld    (hl),0
  781.     dec    hl
  782.  
  783.     ld    a,d
  784.     or    e        ;is that a block number?
  785.     jr    z,release2    ;no, skip
  786.     djnz    release2    ;loop until ctr expires
  787.  
  788. release3:
  789.     ld    a,(retain)    ;get low byte of retained records
  790.     push    af        ;save low byte
  791.     and    7fh        ;take low 7 bits
  792.     ld    (ix+15),a    ;put new rc into this entry    
  793.  
  794.     pop    af        ;get low byte of retained records
  795.     and    80h        ;keep high bit
  796.     ld    b,a        ;in b
  797.     ld    a,(retain+1)    ;get high byte of retained records
  798.     push    af
  799.     and    0fh        ;keep low 4 bits
  800.     or    b        ;combine with high bit of low byte
  801.     rlca            ;1fh max
  802.     ld    (ix+12),a    ;set new ex
  803.  
  804.     pop    af        ;get high byte of retained records
  805.     and    0f0h        ;keep high 4 bits
  806.     rrca
  807.     rrca
  808.     rrca
  809.     rrca
  810.     ld    (ix+14),a    ;set new s2
  811.  
  812.     jp    truncat4    ;re-enter truncation routine
  813.  
  814.  
  815. ; Our ostensible purpose is to find the first matching entry in
  816. ; the directory.  First, though, initialize XLT, and EXTENT and 
  817. ; DSEC figures from dpb information.
  818.  
  819. f.first:
  820.     push    de
  821.     ld    a,(fcb1)    ;get disk select
  822.     dec    a        ;0=A:
  823.     ld    c,a
  824.     set    0,e        ;not the first select
  825.     call    seldsk
  826.     ld    hl,(bioshl)    ;returned by bios
  827.     ld    de,xlt        ;HL ptr to dph
  828.     ldi            ;copy address of translate table
  829.     ldi
  830.     pop    de
  831.  
  832.     ld    hl,(blksize)    ;space allocated by one block
  833.     add    hl,hl
  834.     add    hl,hl
  835.     add    hl,hl        ;*2^3
  836.     ld    a,(dsm+1)    ;disk sector mask high byte into a
  837.     or    a        ;zero if 8-bits name a block
  838.     jr    nz,$+3        ;not zero if 16-bits name a block
  839.     add    hl,hl        ;*2^4
  840.     ld    (extent),hl    ;space allocated by one dir entry
  841.  
  842.     ld    hl,(drm)    ;disk directory mask into HL
  843.     inc    hl        ;count the 0 sector
  844.     ld    b,2        ;divide by 4 (2^2)
  845.     or    a        ;clear carry
  846.     rr    h
  847.     rr    l
  848.     djnz    $-5
  849.     ld    (dsec),hl    ;set number of directory sectors
  850.  
  851.     ld    hl,(off)    ;starting track offset
  852.     ld    (track),hl    ;first track of directory
  853.  
  854.     jr    f.next1        ;read the first sector
  855.  
  856.  
  857. ; "Get" next matching entry.  This may already be in the buffer.
  858. ; First check the remaining entries in the buffer, then, if
  859. ; necessary, read a new sector of the directory.  Function is
  860. ; equivalent to syslib's f$next.
  861.  
  862. f.next:
  863.     ld    a,(tptr)    ;last ptr into tbuff
  864.     add    a,020h        ;next dir entry
  865.     jr    z,f.next1    ;need another sector
  866.     ld    (tptr),a
  867.  
  868.     ld    l,a
  869.     ld    h,0        ;DE ptr to fcb1
  870.     ld    b,(hl)        ;check user area
  871.     ld    a,(user)
  872.     cp    b
  873.     jr    nz,f.next    ;not right, skip
  874.  
  875.     push    de        ;@fncmp changes DE and HL
  876.     inc    hl
  877.     inc    de
  878.     ld    b,11        ;compare filename,ext
  879.     call    @fncmp        ;7 bits, no wildcards
  880.     pop    de
  881.     jr    nz,f.next    ;no match, loop
  882.  
  883.     ld    a,(tptr)    ;restore all-important offset
  884.     or    a        ;set NZ
  885.     ret
  886.  
  887. ; have exhausted the four entries of the current directory sector
  888. ; looking for a match; must read another sector.  before reading,
  889. ; be sure to write this sector back to disk if we want to save it.
  890.  
  891. ; check for end of track and increment if neccesary.  check for 
  892. ; end of directory.
  893.  
  894. ; My old CP/M manual says disks with 0000h for XLT do not perform
  895. ; logical to physical translations (thus no translate table
  896. ; address).  Bridger Mitchell says one should "Always call the 
  897. ; bios sectran, for the odd bios that maps 1...n to 0...n-1 without 
  898. ; showing an xlate table in the dph."
  899.  
  900. f.next1:
  901.     ld    a,tbuff-020h
  902.     ld    (tptr),a    ;store new ptr into buffer
  903.  
  904.     ld    a,(writef)    ;do we want to save this sector?
  905.     or    a
  906.     call    nz,write    ;yup, write it
  907.     or    a
  908.     scf            ;C for error
  909.     ret    nz        ;error on write?
  910.     ld    (writef),a    ;and reset write flag
  911.  
  912.     push    de
  913.     ld    bc,(track)    ;last track read
  914.     ld    de,(sector)    ;last sector read
  915.     ld    hl,(spt)    ;more sectors on this track?
  916.     or    a
  917.     sbc    hl,de        ;Z if no more (hold flag)
  918.     ex    de,hl        ;sector into HL
  919.     inc    hl        ;pt to next sector
  920.     pop    de
  921.  
  922.     jr    nz,$+6        ;now use flag
  923.     inc    bc        ;increment track
  924.     ld    hl,1        ;reset sector
  925.  
  926.     ld    (track),bc    ;save track
  927.     ld    (sector),hl    ;save sector
  928.  
  929.     ld    hl,(dsec)    ;number of sectors in directory
  930.     ld    a,h
  931.     or    l
  932.     ret    z        ;Z for directory exhausted
  933.     dec    hl        ;subtract the next one
  934.     ld    (dsec),hl
  935.  
  936.     call    settrack
  937.     ld    bc,(sector)    ;number of desired sector
  938.     dec    bc
  939.     push    de
  940.     ld    de,(xlt)    ;ptr to translation table
  941.     call    sectran        ;logical to physical translation
  942.     ld    hl,(bioshl)
  943.     ld    b,h
  944.     ld    c,l        ;move result to BC
  945.     pop    de
  946.  
  947.     call    setsect        ;set sector for read
  948.     call    read
  949.     or    a
  950.     jr    z,f.next    ;check for matching entries
  951.  
  952.     scf            ;C for non-recoverable error
  953.     ret
  954.  
  955.  
  956.     subttl    evaluate the need for compression
  957.  
  958. ; Going through the list, add offset and length of first member.
  959. ; Subtract this from the offset of the next member.  Accumulate
  960. ; difference in WASTE.  Obtain disk blocking factor from bdos and
  961. ; subtract WASTE from blocking.  On return, C will indicate free
  962. ; sectors add up to more than one block or more than the number of
  963. ; sectors used in the last block; compression will be beneficial.
  964.  
  965. justify:
  966.     ld    bc,0        ;clear accumulator
  967.     ld    hl,(list)
  968.     push    hl
  969.     pop    ix        ;IX ptr to first entry
  970.     ld    de,entsize    ;DE offset to next entry
  971.     add    hl,de
  972.     push    hl
  973.     pop    iy        ;IY ptr to second entry
  974.  
  975.     ld    a,(ix+0)    ;check for list terminator
  976.     or    a
  977.     jr    z,justify2    ;no list
  978.  
  979. justify1:
  980.     ld    l,(ix+11)
  981.     ld    h,(ix+12)    ;HL index of first member
  982.  
  983.     ld    e,(ix+13)
  984.     ld    d,(ix+14)    ;DE length of first member
  985.  
  986.     add    hl,de        ;HL index to end of first member
  987.  
  988.     ld    a,(iy+0)    ;check for list terminator
  989.     or    a
  990.     jr    z,justify2
  991.  
  992.     ld    e,(iy+11)
  993.     ld    d,(iy+12)    ;DE index to second member
  994.  
  995.     ex    de,hl
  996.     or    a
  997.     sbc    hl,de        ;HL free space between members
  998.  
  999.     add    hl,bc
  1000.     ld    b,h
  1001.     ld    c,l        ;BC accumulator for free space
  1002.  
  1003.     ld    de,entsize    ;length of a list entry
  1004.     add    ix,de        ;move ix to next entry
  1005.     add    iy,de        ;move iy to next entry
  1006.     jr    justify1
  1007.  
  1008. justify2:
  1009.     ld    de,fcb1
  1010.     ld    a,23h        ;compute file size
  1011.     call    dos
  1012.  
  1013.     ex    de,hl        ;end of final member into DE
  1014.     ld    hl,(fcb1+33)    ;file size into HL
  1015.     ld    (fsize),hl    ;save for later
  1016.     ld    a,(fcb1+35)    ;check last byte for overflow
  1017.     or    a
  1018.     jp    nz,abort    ;too big for us to handle
  1019.     sbc    hl,de        ;free space on end of file
  1020.  
  1021.     add    hl,bc        ;add previous waste value
  1022.     ld    b,h
  1023.     ld    c,l        ;copy to BC
  1024.     ld    (waste),hl    ;store free space
  1025.  
  1026.     ld    a,1fh
  1027.     call    dos        ;get address of disk parameters
  1028.  
  1029.     push    bc
  1030.     ld    hl,(bdoshl)    ;ptr to dpb base
  1031.     ld    de,spt        ;ptr to disk param storage
  1032.     ldi
  1033.     ldi            ;HL ptr to bsh
  1034.     ldi            ;HL ptr to blm
  1035.     ld    a,(hl)        ;blm into a
  1036.     ld    bc,dparms    ;number to copy
  1037.     ldir            ;get these to local storage
  1038.     ld    l,a        ;blm into l
  1039.     ld    h,b        ;HL is blm (B = 0)
  1040.     pop    bc        ;get back waste
  1041.     inc    hl        ;HL is sectors per block
  1042.  
  1043.     ld    (blksize),hl    ;save this figure
  1044.     or    a        ;clear carry (DOS #31 may not!)
  1045.     sbc    hl,bc        ;if waste is larger
  1046.     add    hl,bc        ;restore sectors per block first
  1047.     ret    c        ;we know we can gain from compression
  1048.  
  1049.     xor    a        ;use acc to count extents
  1050.     ex    de,hl        ;blocking into DE
  1051.     ld    hl,(fsize)    ;get file size again
  1052.     inc    a        ;incr extent counter
  1053.     sbc    hl,de        ;subtract block by block
  1054.     jr    nc,$-2        ;until we overshoot
  1055.     dec    a        ;back off one extent
  1056.     add    hl,de        ;get positive value again
  1057.  
  1058.     or    a
  1059.     sbc    hl,bc        ;subtract waste again
  1060.     ret
  1061.  
  1062.  
  1063.     subttl    locate the library and open it
  1064.  
  1065. ; Find and open the library.  Build a list of library members along
  1066. ; with their offset and length.  Sort the list ascending by offset
  1067. ; (first physical member must be first in list).  Return C on error
  1068. ; of any kind.  Called with DE pointing to FCB1.
  1069.  
  1070. openlbr:
  1071.     ld    hl,'BL'        ;force filetype
  1072.     ld    a,'R'
  1073.     ld    (fcb1+9),hl    ;blr
  1074.     ld    (fcb1+11),a
  1075.  
  1076.     ld    a,(de)        ;get drive select
  1077.     or    a
  1078.     jr    nz,$+7        ;set, skip ahead
  1079.     call    getdsk        ;not set, get current disk
  1080.     inc    a        ;adjust for drive select
  1081.     ld    (de),a        ;lock it in
  1082.  
  1083.     dec    a
  1084.     call    setdsk        ;and select it through bdos
  1085.     ld    a,(fcb1+13)    ;get user
  1086.     ld    (user),a    ;save it
  1087.     call    savusr        ;go there
  1088.  
  1089.     call    f$open        ;is it there?
  1090.     scf
  1091.     ret    nz        ;no, quit
  1092.  
  1093.     call    environ2    ;check for DosDisk
  1094.     ret    c        ;found it, quit
  1095.  
  1096.     ld    hl,tbuff
  1097.     call    setdma        ;read first sector to default buffer
  1098.     ld    l,h
  1099.     ld    (opnrec),hl
  1100.     call    r$read
  1101.     scf
  1102.     ret    nz        ;must be zero length, quit
  1103.  
  1104.     ld    a,(tbuff)
  1105.     ld    l,8ch        ;ptr to index of directory member
  1106.     or    (hl)        ;(H = 0 from above)
  1107.     inc    hl
  1108.     or    (hl)
  1109.     inc    hl        ;ptr to length of directory
  1110.     scf
  1111.     ret    nz        ;not a library
  1112.  
  1113.     ld    de,dirlen
  1114.     ldi
  1115.     ldi
  1116.  
  1117.     ld    de,(list)
  1118.  
  1119. openlbr1:
  1120.     ld    hl,80h        ;ptr
  1121.     ld    b,4        ;four files per directory sector
  1122.  
  1123. openlbr2:
  1124.     push    hl
  1125.     call    cntdo
  1126.     pop    hl
  1127.     ld    a,(hl)        ;active entry?
  1128.     or    a
  1129.     ld    a,b
  1130.     jr    nz,openlbr3    ;this one's bad, skip it
  1131.  
  1132.     ld    a,(delbuf)
  1133.     or    a
  1134.     ld    a,b
  1135.     jr    z,openlbr4
  1136.  
  1137. del:    push    hl
  1138.     push    de
  1139.     push    bc
  1140.     ex    de,hl
  1141.     inc    de
  1142.     ld    hl,delbuf
  1143.     ld    a,(de)
  1144.     sub    space
  1145.     jr    nz,del1
  1146.     dec    a
  1147.     jr    del2
  1148. del1:    ld    a,','
  1149.     cpi
  1150.     jr    nz,del2
  1151.     push    de
  1152.     push    hl
  1153.     ld    b,11
  1154.     call    @afncmp
  1155.     pop    hl
  1156.     pop    de
  1157.     ld    bc,11
  1158.     add    hl,bc
  1159.     jr    nz,del1
  1160.     ld    hl,(cntact)
  1161.     dec    hl
  1162.     ld    (cntact),hl
  1163.     call    incdel
  1164.     call    pfn2
  1165.     ld    a,0feh
  1166.     ld    (delflg),a    ;deletion flag for current record
  1167.     dec    de        ;point to status byte
  1168.     ld    (de),a        ;mark as deleted for safety
  1169.     call    eprint        ;inform user
  1170.     db    ' deleted.',cr,lf,0
  1171.     xor    a        ;A = 0, Z
  1172.     ld    (override),a    ;stipulate directory compact
  1173. del2:    pop    bc
  1174.     pop    de
  1175.     pop    hl
  1176.     ld    a,b        ;entry counter to A
  1177.     jr    z,openlbr3
  1178.  
  1179. openlbr4:
  1180.     push    hl
  1181.     inc    hl        ;ptr to filename
  1182.     ld    bc,entsize
  1183.     ldir            ;copy directory info to list
  1184.     pop    hl
  1185.  
  1186. openlbr3:
  1187.     ld    bc,20h        ;move to next member
  1188.     add    hl,bc        ;HL ptr to next member
  1189.     ld    b,a        ;entry counter to B
  1190.     djnz    openlbr2    ;loop through this record
  1191.  
  1192.     ld    hl,(dirlen)
  1193.     dec    hl
  1194.     ld    (dirlen),hl    ;decr sector count of directory
  1195.     ld    a,h
  1196.     or    l        ;see if there are more
  1197.     jr    z,openlbr5    ;no, that was it
  1198.  
  1199.     push    de        ;save list ptr
  1200.     ld    de,fcb1
  1201.     ld    hl,(opnrec)    ;get current record number
  1202.     ld    a,(delflg)    ;did we delete?
  1203.     or    a
  1204.     call    nz,r$write    ;if so, write back record
  1205.     jr    nz,openerr    ;trap any error
  1206.     ld    (delflg),a    ;reset local delete flag
  1207.     inc    hl        ;next record number
  1208.     ld    (opnrec),hl    ;store it &
  1209.     call    r$read        ;read the next record
  1210. openerr:
  1211.     pop    de
  1212.     jp    z,openlbr1    ;extract files from this record
  1213.     scf
  1214.     ret            ;read error (NZ + C)
  1215.  
  1216. openlbr5:
  1217.     ex    de,hl        ;ptr to end of library in HL
  1218.     ld    (hl),a        ;set terminator (A = 0)
  1219.     inc    hl
  1220.     ld    (bptr),hl    ;buffer may begin here
  1221.  
  1222.  
  1223. ; Fall through to sort list entries by their indices.  Pt to first
  1224. ; entry, compare its index to each of the later entries in the list.
  1225. ; At the end of the first round, the lowest index is at the top of
  1226. ; the list; other entries are still out of order.  Pt to the second
  1227. ; entry and go through the list again; the second lowest index will
  1228. ; be in the second list position at the end of the second pass.
  1229.  
  1230. ; The following sort routine has no error detection.  We should
  1231. ; be monitoring for matching indices and...what?...abort the 
  1232. ; compression if found?
  1233.  
  1234. ;sort:
  1235.     ld    ix,(list)
  1236.     ld    a,(ix+0)    ;check for terminator
  1237.     or    a
  1238.     ret    z        ;nothing in list
  1239.  
  1240. sort0:
  1241.     push    ix        ;IX ptr to first entry
  1242.     pop    iy
  1243.     ld    de,entsize
  1244.     add    iy,de        ;IY ptr to second entry
  1245.  
  1246.     ld    a,(iy+0)    ;check for end of list
  1247.     or    a
  1248.     ret    z        ;we be done
  1249.  
  1250. sort1:
  1251.     ld    h,(ix+12)    ;high byte of index
  1252.     ld    l,(ix+11)    ;low byte of index
  1253.  
  1254.     ld    d,(iy+12)    ;high byte of index
  1255.     ld    e,(iy+11)    ;low byte of index
  1256.  
  1257.     or    a
  1258.     sbc    hl,de        ;which came first
  1259.     jr    c,sort3        ;DE is larger, comes later, skip swap
  1260.  
  1261.     push    ix        ;swap entries
  1262.     pop    hl        ;HL ptr first entry (high index)
  1263.     push    iy
  1264.     pop    de        ;DE ptr to second entry (low index)
  1265.  
  1266.     ld    b,entsize
  1267. sort2:
  1268.     ld    a,(de)        ;shuffle
  1269.     ld    c,a
  1270.     ld    a,(hl)
  1271.     ld    (de),a
  1272.     ld    (hl),c
  1273.     inc    hl
  1274.     inc    de
  1275.     djnz    sort2
  1276.  
  1277. sort3:
  1278.     ld    de,entsize    ;bump high ptr
  1279.     add    iy,de
  1280.     ld    a,(iy+0)    ;check for end of list
  1281.     or    a
  1282.     jr    nz,sort1    ;not at end, loop
  1283.  
  1284.     add    ix,de        ;bump low ptr
  1285.     jr    sort0
  1286.  
  1287.  
  1288.     subttl    re-write the library directory and close file
  1289.  
  1290. ; Write a new library directory from the information in the list.
  1291. ; Any previously deleted members have now been overwritten, so
  1292. ; their directory entries must be removed (they may not be un-
  1293. ; deleted now).
  1294.  
  1295. closlbr:
  1296.     ld    hl,tbuff
  1297.     call    setdma
  1298.  
  1299.     ld    l,0        ;read 1st record of lbr (HL = 0)
  1300.     ld    (cntopn),hl    ;zero out all three counts now
  1301.     ld    (cntdel),hl
  1302.     ld    (cntact),hl
  1303.     ld    de,fcb1        ;for directory entry
  1304.     call    r$read
  1305.  
  1306.     ld    hl,(tbuff+14)    ;get length of dir in sectors
  1307.     add    hl,hl
  1308.     add    hl,hl        ;get number of dir entries
  1309.     ex    de,hl        ;number of entries into DE
  1310.  
  1311.     ld    hl,(bptr)    ;copy buffer is free now
  1312. closlbr1:
  1313.     ld    (hl),0ffh    ;mark it unused
  1314.     inc    hl
  1315.  
  1316.     ld    b,11
  1317.     ld    (hl),space    ;init filename.typ
  1318.     inc    hl
  1319.     djnz    $-3
  1320.  
  1321.     ld    b,20
  1322.     ld    (hl),0        ;fill out dir with 00h
  1323.     inc    hl
  1324.     djnz    $-3
  1325.  
  1326.     dec    de        ;decr count of entries
  1327.     ld    a,d
  1328.     or    e        ;Z if we're through
  1329.     jr    nz,closlbr1    ;do another
  1330.  
  1331.     ld    de,(bptr)    ;ptr to new directory
  1332.     ld    hl,(list)
  1333.     jr    clostmp
  1334.  
  1335. closlbr2:
  1336.     xor    a
  1337.     ld    (de),a        ;mark entry active
  1338.     push    de
  1339.     inc    de
  1340.  
  1341.     ld    bc,entsize
  1342.     ldir            ;copy list to directory
  1343.     pop    de
  1344.  
  1345. closlbr3:
  1346.     push    hl
  1347.     ld    hl,20h
  1348.     add    hl,de
  1349.     ex    de,hl
  1350.     pop    hl
  1351.  
  1352. clostmp:
  1353.     ld    a,(hl)        ;check for end of list
  1354.     or    a
  1355.     jr    nz,closlbr2    ;copy another member to dir
  1356.  
  1357.     ld    hl,(bptr)    ;pt to dir entry again
  1358.  
  1359.     ld    de,14        ;offset to dir length
  1360.     add    hl,de
  1361.     ld    c,(hl)
  1362.     inc    hl
  1363.     ld    b,(hl)        ;BC is length of dir
  1364.  
  1365.     inc    hl
  1366.     ld    d,h
  1367.     ld    e,l        ;copy ptr to DE
  1368.     ld    (hl),0        ;HL now ptr to crc
  1369.     inc    hl
  1370.     ld    (hl),0        ;zero out the old crc
  1371.  
  1372.     ld    h,b        ;copy length of dir to HL
  1373.     ld    l,c
  1374.     ld    b,7
  1375. multlp:    add    hl,hl
  1376.     djnz    multlp        ;compute HL*2^7 (saves 2 bytes
  1377.                 ;compared to previous code)    
  1378.     ld    c,l        ;number of bytes in dir
  1379.     ld    b,h        ;copy back to BC
  1380.  
  1381.     call    crc3clr        ;initialize crc-16
  1382.     push    bc        ;bytes in dir to stack
  1383.     push    de        ;pointer to CRC on stack
  1384.     ld    de,32        ;length of member entry
  1385.     call    divhd        ;compute number of records to sort
  1386.     ld    b,h        ;into BC
  1387.     ld    c,l
  1388.     ld    hl,(bptr)
  1389.     push    hl
  1390.     call    sort        ;SigiSORT 'em (Shell-Metzner wo/pointers)
  1391.     pop    hl        ;bptr
  1392.     pop    de        ;pointer to CRC
  1393.     pop    bc        ;length in bytes
  1394. closlbr4:
  1395.     ld    a,(hl)        ;get a byte from dir
  1396.     inc    hl        ;pt to next byte
  1397.     call    crc3upd        ;rotate into crc
  1398.     dec    bc
  1399.     ld    a,b
  1400.     or    c        ;see if there are more to go
  1401.     jr    nz,closlbr4    ;go around again
  1402.  
  1403.     call    crc3done    ;get crc into HL
  1404.     ex    de,hl        ;DE is still ptr to crc storage
  1405.     ld    (hl),e
  1406.     inc    hl
  1407.     ld    (hl),d        ;store new crc in directory
  1408.  
  1409.     ld    hl,(bptr)    ;ready to write it out again
  1410.     call    setdma
  1411.     ex    de,hl        ;last DMA into DE
  1412.     ld    hl,14        ;offset to length of dir
  1413.     add    hl,de
  1414.     ld    c,(hl)
  1415.     inc    hl
  1416.     ld    b,(hl)        ;length into BC
  1417.     ld    hl,0        ;start with record 0
  1418.  
  1419. closlbr5:
  1420.     push    de        ;save DMA
  1421.     ld    de,fcb1        ;pt to library fcb
  1422.     call    r$write        ;HL is record number
  1423.     pop    de
  1424.  
  1425.     inc    hl        ;incr record
  1426.     push    hl        ;save record
  1427.     call    cntent
  1428.     ld    hl,80h        ;bump DMA
  1429.     add    hl,de
  1430.     call    setdma
  1431.     ex    de,hl        ;hold last DMA in DE
  1432.     pop    hl
  1433.  
  1434.     dec    bc        ;decr record count
  1435.     ld    a,b        ;see if that's the end
  1436.     or    c
  1437.     jr    nz,closlbr5    ;write another record
  1438.  
  1439.     ld    de,fcb1
  1440.     jp    f$close        ;close library, jp=call!ret
  1441.                 ;free at last, free at last
  1442.  
  1443.  
  1444.     subttl    entertainment section
  1445.  
  1446. ; HL contains the number of records just written (or the number in
  1447. ; the original library if entry is happy2).  Print the number of
  1448. ; Kilobytes this represents so the user will have something to
  1449. ; watch.
  1450.  
  1451. happy:
  1452.     push    hl
  1453.     push    de
  1454.     push    bc
  1455.     ld    b,6
  1456.     ld    a,bs        ;print six backspaces to
  1457.     call    cout        ;overwrite the last display
  1458.     djnz    $-3
  1459.  
  1460.     jr    happy3        ;print xxxxxK
  1461.  
  1462. happy2:
  1463.     push    hl
  1464.     push    de
  1465.     push    bc
  1466.     ld    bc,0803h    ;start with three and
  1467.                 ;look at 8 characters of the filename
  1468.     ld    hl,fcb1+1
  1469.  
  1470.     ld    a,(hl)
  1471.     inc    hl
  1472.     cp    space        ;count it if it's a space
  1473.     jr    nz,$+3
  1474.     inc    c
  1475.     djnz    $-7
  1476.  
  1477.     ld    b,c        ;number of spaces to print
  1478.     ld    a,space        ;3 plus any in the filename
  1479.     call    cout
  1480.     djnz    $-3
  1481.  
  1482.     ld    hl,(fsize)    ;filesize into HL
  1483.  
  1484. happy3:
  1485.     ld    a,(blm)        ;get block mask
  1486.     ld    b,a        ;save
  1487.     and    l        ;is it even already?
  1488.     ld    a,b        ;restore
  1489.     jr    z,$+5        ;yes, even, skip
  1490.     or    l        ;combine with record count
  1491.     ld    l,a        ;to round up to next block
  1492.     inc    hl        ;even block
  1493.  
  1494.     ld    b,3        ;divide HL by 2^3
  1495.     xor    a        ;clear carry
  1496.     rr    h
  1497.     rr    l
  1498.     djnz    $-5
  1499.  
  1500.     call    phldc
  1501.     ld    a,'K'
  1502.     call    cout
  1503.  
  1504.     pop    bc
  1505.     pop    de
  1506.     pop    hl
  1507.     ret
  1508.  
  1509. ; Imitate ZPRSFN under CP/M 2.2, except for file ambiguity test
  1510. ; (returns with Z set if parse is OK).  HL, BC, & A destroyed.
  1511.  
  1512. parse:
  1513.     call    fname
  1514.     inc    a
  1515.     ret    nz
  1516.     ld    a,b
  1517.     inc    a
  1518.     jr    z,parse1
  1519.     dec    a
  1520. parse1:
  1521.     ld    (de),a
  1522.     ld    a,c
  1523.     cp    '?'
  1524.     jr    z,parse2
  1525.     cp    0ffh
  1526.     jr    nz,parse3    
  1527. parse2:    ld    a,(tmpusr)
  1528. parse3:    ld    hl,13
  1529.     add    hl,de
  1530.     ld    (hl),a
  1531.     xor    a
  1532.     ret
  1533.  
  1534. ; Print du:library.LBR from FCB1 and "USER:"
  1535. ; uses DE and A only, all others preserved
  1536.  
  1537. lpfn:    ld    de,fcb1
  1538.     ld    a,(de)
  1539.     add    a,'@'
  1540.     call    cout
  1541.     ld    a,(user)
  1542.     call    pafdc
  1543.     ld    a,':'
  1544.     call    cout
  1545.     inc    de
  1546.     jp    pfn2
  1547.  
  1548.  
  1549.     subttl    bdos disk/user handling
  1550.  
  1551. ; SAVUSR stores the current user area and sets the user area passed
  1552. ; in A; RETUSR restores to the original area.
  1553.  
  1554. savusr:
  1555.     push    af            ;preserve flags
  1556.     push    af            ;save destination
  1557.     call    getusr
  1558.     ld    (tmpusr),a
  1559.     pop    af            ;get destination
  1560.     jr    savusr1
  1561.  
  1562. retusr:
  1563.     push    af            ;preserve flags
  1564.     ld    a,(tmpusr)
  1565.  
  1566. savusr1:
  1567.     call    setusr
  1568.     pop    af            ;restore flags
  1569.     ret
  1570.  
  1571.  
  1572. ; GETUSR returns the current user area in A.  SETUSR sets the user
  1573. ; area to the code passed in A.
  1574.  
  1575. getusr:
  1576.     ld    a,0ffh
  1577. setusr:
  1578.     push    de
  1579.     ld    e,a        ;move code to E
  1580.     ld    a,20h        ;get/set user code
  1581.     call    dos
  1582.     dec    a
  1583.     pop    de
  1584.     ret
  1585.  
  1586. ; SETDSK sets the default drive from the code in A (drive A = 0).
  1587.  
  1588. setdsk:
  1589.     push    de
  1590.     ld    e,a
  1591.     ld    a,0eh
  1592.     call    dos        ;no return code
  1593.     pop    de
  1594.     ret
  1595.  
  1596. ; GETDSK returns the code of the default disk in A (drive A = 0).
  1597.  
  1598. getdsk:
  1599.     ld    a,19h        ;return current disk
  1600.     call    dos
  1601.     dec    a
  1602.     ret
  1603.  
  1604. ; BDOS access.  Pass function in A.
  1605.  
  1606. dos:
  1607.     push    hl
  1608.     push    de
  1609.     push    bc
  1610.     ld    c,a        ;move function code to C
  1611.     call    5        ;call BDOS
  1612.     ld    (bdoshl),hl    ;save this information
  1613.     pop    bc
  1614.     pop    de
  1615.     pop    hl
  1616.     inc    a        ;if CP/M error code is 0ffh,
  1617.     ret            ;this routine returns Z=error
  1618.  
  1619.  
  1620.     subttl    LBR directory evaluation
  1621.  
  1622. cntent:    ld    a,(de)
  1623.     call    cntdo1
  1624.     ld    hl,32
  1625.     add    hl,de
  1626.     call    cntdo
  1627.     ld    hl,64
  1628.     add    hl,de
  1629.     call    cntdo
  1630.     ld    hl,96
  1631.     add    hl,de
  1632. ;    FALL    THROUGH
  1633. cntdo:    ld    a,(hl)
  1634. cntdo1:    or    a
  1635.     jr    z,incact
  1636.     inc    a
  1637.     jr    z,incopn
  1638.     inc    a
  1639.     ret    nz
  1640. ;    FALL    THROUGH
  1641. incdel:    ld    hl,(cntdel)
  1642.     inc    hl
  1643.     ld    (cntdel),hl
  1644.     ret
  1645. incact:    ld    hl,(cntact)
  1646.     inc    hl
  1647.     ld    (cntact),hl
  1648.     ret
  1649. incopn:    ld    hl,(cntopn)
  1650.     inc    hl
  1651.     ld    (cntopn),hl
  1652.     ret
  1653.  
  1654.  
  1655.     subttl    Handle Member Counts & Plurals
  1656.  
  1657. prnmbr:    ld    a,l
  1658.     or    h
  1659.     jp    nz,phlfdc
  1660.     call    eprint
  1661.     db    'no',0
  1662.     ret
  1663.  
  1664. plural:    push    af
  1665.     dec    hl
  1666.     ld    a,l
  1667.     or    h
  1668.     ld    a,'s'
  1669.     call    nz,cout
  1670.     pop    af
  1671.     ld    a,','
  1672.     jr    c,plural1
  1673.     ld    a,'.'
  1674. plural1:
  1675.     call    cout
  1676.     ld    a,space
  1677.     call    c,cout
  1678.     ret
  1679.  
  1680.  
  1681.     subttl    Delete Buffer Init.
  1682.  
  1683. delini:    ld    hl,tbuff
  1684.     ld    c,(hl)
  1685.     ld    b,h        ;BC has length (HL =0)
  1686.     dec    bc
  1687.     inc    hl
  1688.     inc    hl
  1689.     ld    a,space
  1690.     cpir
  1691.     ret    nz
  1692.     ld    a,'-'
  1693.     cpir
  1694.     ret    nz
  1695.     ld    de,delbuf
  1696. delilp:    call    fname
  1697.     call    sksp
  1698.     ld    a,','
  1699.     ld    (de),a
  1700.     cpi
  1701.     ret    nz
  1702.     ex    de,hl        ;buffer pointer to HL
  1703.     ld    bc,12        ;offset to next spot
  1704.     add    hl,bc        ;new pointer in HL and
  1705.     ex    de,hl        ;back to DE, command line to HL
  1706.     call    sksp        ;skip any blanks
  1707.     jr    delilp        ;loop around
  1708.  
  1709.  
  1710.     subttl    bios access handling
  1711.  
  1712. seldsk:
  1713.     ld    a,9
  1714.     jr    bios
  1715.  
  1716. settrack:
  1717.     ld    a,10
  1718.     jr    bios
  1719.  
  1720. setsect:
  1721.     ld    a,11
  1722.     jr    bios
  1723.  
  1724. read:
  1725.     ld    a,13
  1726.     jr    bios
  1727.  
  1728. write:
  1729.     ld    c,1        ;directory write
  1730.     ld    a,14
  1731.     jr    bios
  1732.  
  1733. sectran:
  1734.     ld    a,16
  1735. ;    jr    bios
  1736. ;    FALL    THROUGH to bios:
  1737.  
  1738.  
  1739. bios:
  1740.     push    hl
  1741.     push    de
  1742.     push    bc
  1743.  
  1744.     push    hl
  1745.     ld    hl,return    ;this routine's return address
  1746.     ex    (sp),hl        ;on stack
  1747.  
  1748.     push    hl
  1749.     push    de
  1750.  
  1751.     ld    hl,(1)        ;get bios vector
  1752.     ld    d,0
  1753.     ld    e,a        ;DE is vector number
  1754.     dec    de        ;cold boot is vector 1
  1755.  
  1756.     add    hl,de
  1757.     add    hl,de
  1758.     add    hl,de        ;HL ptr to selected vector
  1759.     pop    de
  1760.  
  1761.     ex    (sp),hl
  1762.     ret            ;call bios
  1763. return:
  1764.     ld    (bioshl),hl    ;save reg
  1765.     pop    bc
  1766.     pop    de
  1767.     pop    hl
  1768.     ret
  1769.  
  1770.  
  1771.     dseg
  1772.  
  1773. dsbegn:    ds    0
  1774. z3flag:    ds    1    ;non-zero if running under ZCPR3
  1775. disk:    ds    1    ;disk selected on entry
  1776. user:    ds    1    ;user area for library
  1777. tmpusr:    ds    1    ;temporary user area storage
  1778. inquiry:
  1779.     ds    1    ;flag from command line to prevent compact
  1780. override:
  1781.     ds    1    ;flag from command line to force compact
  1782. justfl:    ds    1    ;if zero, skip compact and truncate calls
  1783. delflg:    ds    1    ;local member delete flag
  1784. opnrec:    ds    2    ;random record number for "openlbr:"
  1785. stack:    ds    2    ;storage for original stack ptr
  1786. tpaend:    ds    2    ;ptr to end of buffer space
  1787. list:    ds    2    ;ptr to base of list buffer
  1788. bptr:    ds    2    ;ptr to base of copy buffer
  1789. bcnt:    ds    2    ;count of records copied into buffer
  1790.  
  1791. cntact:    ds    2    ;count of active LBR members
  1792. cntdel:    ds    2    ;count of deleted LBR members
  1793. cntopn:    ds    2    ;count of open LBR member slots
  1794.  
  1795. waste:    ds    2    ;free space within library on entry
  1796. retain:    ds    2    ;used space within library after packing
  1797. fsize:    ds    2    ;size of original file
  1798. blksize:
  1799.     ds    2    ;size of disk allocation block
  1800. extent:    ds    2    ;space controlled by one directory entry
  1801.  
  1802. xlt:    ds    2    ;translation table for this disk
  1803. spt:    ds    2    ;sectors per track
  1804. bsh:    ds    1    ;block shift factor
  1805. blm:    ds    1    ;allocation block mask
  1806. exm:    ds    1    ;extent mask
  1807. dsm:    ds    2    ;storage on this disk
  1808. drm:    ds    2    ;directory entries this disk
  1809. al0:    ds    1    ;low 8
  1810. al1:    ds    1    ;high 8
  1811. cks:    ds    2    ;directory check vector
  1812. off:    ds    2    ;number of reserved tracks
  1813. dparms    equ    $-blm
  1814.  
  1815. offset:    ds    2    ;read ptr into member when buffer fills
  1816. length:    ds    2    ;remaining length of member when buffer fills
  1817. dirlen:    ds    2    ;temp storage for length of directory
  1818.  
  1819. tptr:    ds    1    ;ptr into tbuff when truncating file length
  1820. writef:    ds    1    ;0=don't re-write this sector
  1821. dsec:    ds    2    ;number of directory sectors on disk
  1822. track:    ds    2    ;track we just set
  1823. sector:    ds    2    ;sector we just read of directory
  1824.  
  1825. bioshl:    ds    2    ;storage for bios return information
  1826. bdoshl:    ds    2    ;storage for bdos return information
  1827.  
  1828. delbuf:    ds    384    ;VERY conservative, for delete FCB's
  1829.  
  1830. dslen    equ    $-dsbegn
  1831.  
  1832.     end
  1833.