Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / cpm / arc-lbr / cl10.lbr / CL10.ZZ0 / CL10.Z80

Wrap

Text File | 1991-05-07 | 40.8 KB | 1,833 lines

;Program: CL (Compact Library) ;Authors: Michal Carson and Bruce Morgen ;Version: 1.0 ;Date: May 7, 1991 ;Purpose: This utility has one purpose: to compact a ; library. It is invoked by the command "CL ; filename" in which "filename" is assumed to ; have the extension LBR. CL compresses the ; library, overwriting deleted entries and ; other unused sectors of the LBR file with ; active members. CL then de-allocates the ; remaining blocks and/or extents of the LBR ; file. This method may not be compatible with ; all systems, so caution is advised. CL does ; not create a new library. It overwrites the ; existing library. ; v1.0 April 27 - May 7, 1991 Bruce Morgen ; Release version, eliminated warm boot when an RSX is detected, ; fixed a stack imbalance bug when zero-length member files are ; present (reported by Terry Hazen - thanks!) Saved a few bytes ; through more double register SBC!ADD sequences as per Joe ; Wright via Howard Goldstein, shortened DosDisk test. ; v0.09 April 19, 1991 Bruce Morgen ; Added "-afn,afn,afn" delete member function. File is compacted ; in this mode to avoid weird "ghost" spaces unless the deleted ; members were all zero-length. ; v0.08 April 18, 1991 Bruce Morgen ; If there is no "waste" and the "Z" option is selected, no compact ; is done, but the LBR's directory is sorted and rewritten as ; suggested by Bob Dean. LBR's active, deleted, and open member ; statistics are displayed as suggested by Terry Hazen. Deleted ; FRESET inclusion in favor of linked module and external. ; v0.07 ?????? ; v0.06 October 23, 1990 Bruce Morgen ; LBR directory now sorted. Suggested by Bob Dean. ; v0.05 October 20, 1990 Bruce Morgen ; Z80 and CP/M 2.2 tests performed earlier, stack-hungry ; EPRINT not called until local stack established. Suggested ; by Howard Goldstein. ; v0.04 October 19, 1990 Bruce Morgen ; Fixed nasty problem caused by Michal's assumption that DS ; directives zero-fill. When CL's buffers were put in DSEG, ; CL would unpredictably hang the system. Used the brute force ; solution of zero-filling the entire buffer space immediately. ; This has the added benefit of making CL re-executable via GO. ; Somehow stayed within 25 records through dogged code-cutting. ; v0.03 October 17, 1990 Bruce Morgen ; This puppy has been around for a year and a half with no public ; comment that I can recall seeing. Personally, I think it's ; Michal's finest hour -- a fine utility. I have taken the liberty ; of spiffing it up a bit. The size of CL.COM has been reduced by ; four records, mostly though use of DSEG and an appropriate linker. ; PROLINK is a wonderful tool, but it is strictly one-pass and ; cannot do that job. Michal's assumption about ZPRSFN working in ; a non-Z3 environment is simply not true. CL would have to include ; an internal environment descriptor for ZPRSFN (and GETCCP or ; GETZRUN, for that matter) to work predictably. I could have done ; this, but since CL does not need to parse the command line under ; Z-System, I simulated ZPRSFN using SYSLIB's FNAME instead. The ; other somewhat significant change is the use of SYSLIB's table- ; driven CRC routines, which results in a modest-but-measurable ; increase in speed. I was able to knock off a few bytes of code ; here and there, but CL is quite well-crafted and shortening it any ; further would take more effort than is sensible (at least for me). ; Last and certainly least, CL now displays the DU: of the LBR being ; analyzed and/or processed. ; v0.02 04/09/89 Michal Carson ; Howard Goldstein again diagnosed errors in the utility. A minor ; change concerns the location of the first token by the parsing ; routine (zprsfn). More importantly, I had commented out code which ; loaded the address of the sector translation table into DE before ; the call to the BIOS. Also important, I was resetting the low bit ; of E before the call to SETDSK when I should have been setting it. ; Resetting tells the BIOS that the disk has not been accessed ; previously, while setting indicates that the disk has been used. ; Found that I was misusing @fncmp (inserted from syslib for the last ; revision in place of my own routine) and consequently the program ; failed to find some directory entries for the library. Converted ; fully to syslib for all the routines which may be found there. ; v0.01 03/17/89 Michal Carson ; Changes to this beta version of the utility come as a result of ; input from Howard Goldstein and Bridger Mitchell (Bridger ; supplied a nice long list of enhancements). I was able to ; incorporate all but a few of their reccommendations; still have ; some questions about the obscure disk formats. Most changes ; aim to ensure predictable performance under varying systems. ; I think CL has come up to standards there. The utility now ; insists on a Z80 and a BDOS which returns 2.2 as version number. ; CP/M+ and Z3PLUS are not supported; this will come later title Compact Library extrn freset ;freset10 extrn dump ;rdump extrn sort ;mysort extrn z3init,getccp,getzrun,getefcb ;z3lib extrn puter2 ; " extrn f$open,f$close ;syslib extrn r$read,r$write,setdma extrn sksp,fname,@fncmp,@afncmp,divhd extrn eprint,phldc,pafdc,phlfdc,pfn2,cout extrn crc3init,crc3clr,crc3upd,crc3done public $memry version equ 10 ;increments on changes to CL cuss equ 07h bs equ 08h cr equ 0dh lf equ 0ah space equ 020h fcb1 equ 05ch ;address of cpm default fcb tbuff equ 080h ;address of command tail buffer entsize equ 31 ;11 bytes for filename.typ ;4 bytes for index and length of member ;2 bytes for crc-16 ;8 bytes for time and date stamps ;1 byte for padbyte count ;5 bytes for disk use entry: jp start db 'Z3ENV' db 1 z3eadr: dw 0000h ; Leave this alone! db version $memry: dw 0000h noz80: db cuss,'Must have a Z80$' nocpm: db cuss,'Must have CP/M 2.2$' start: ld de,noz80 ld c,9 sub a ;check for Z80 processor jp pe,5 ;we don't have it, inform and exit ld c,0ch ;check system version call 5 ld de,nocpm ld c,9 ld a,l sub 22h ;must be CP/M 2.2 compatible jp nz,5 ;cannot operate, inform and exit ld hl,dsbegn ;Zero out the entire DSEG because ld de,dsbegn+1 ;we don't know which bytes have ld bc,dslen ;to be zero for CL to work. ld (hl),a ;A = 0 from "sub 22h" above ldir ld hl,(z3eadr) ;got Z3 environment? ld a,l or h ;test ld (z3flag),a ;& store jr nz,z3ccp ld hl,(1) ;get BIOS warm boot ld de,-1603h ;offset to 2K CCP add hl,de ;compute CCP address jr cpmccp z3ccp: call z3init ;Z3LIB's wake-up call.... call getccp ;CCP address into HL cpmccp: ld de,(6) ;bdos address into DE xor a ;assure carry cleared sbc hl,de ;find the lower address ex de,hl ;use the bdos address if NC jr nc,setstk ;carry if no RSX present add hl,de ;so restore HL to CCP address setstk: ld (stack),sp ;save stack ptr ld sp,hl ;set stack at top of memory dec h ;100h grace for stack ld (tpaend),hl ;save as end of copy buffer ld hl,($memry) ;ptr to end of code call crc3init ;create CRC table, HL preserved inc h ;table needs 512 bytes inc h ld (list),hl ;initialize base ptr for list call signon ;tell 'em who we are ld a,(fcb1+17) ;first character of second token cp '-' call z,delini sub '?' ;subtract 3fh ld (inquiry),a ;'?' causes exit after free space display sub 1bh ;subtract as though 'Z' ld (override),a ;'Z' forces compact call getdsk ;save currently selected drive ld (disk),a call getusr ;set up a default for exit call savusr ;save current, recall with retusr ld hl,(fcb1+1) ;look for help request ld de,'//' ;signified by two slashes xor a ;clear carry ld a,l ;save byte a fcb+1 in A sbc hl,de ;check for help query jr z,jzhlp ;jump if found cp space+1 ;test for filename from command line jr c,jnzhlp ;no filename given ; Re-parse command line so that du: references will be resolved on ; (why?) non-ZCPR systems. start1: ld de,fcb1 ;ptr to fcb ld a,(z3flag) or a jr nz,start1z ld hl,tbuff+1 ;ptr to command tail call sksp ;find token call parse ;WILL work on any system jnzhlp: jp nz,help ;failed parse, no fair start1z: ld h,d ;check FCB at DE for ambiguity ld l,e ld bc,12 ld a,'?' cpir jzhlp: jp z,help ;ambiguity prohibited, educate call openlbr ;find and open the library jp c,exit1 ;can't find it or form is bad call justify ;evaluate need for compression push af ;save result flag ld hl,(waste) ;free space ld a,l or h ld (justfl),a ;save as byte flag call phlfdc ;print the number call eprint db ' records of free space in ',0 call lpfn ;show the file name call happy2 ;print xxxxxK ld b,3+6 ld a,space ;print 3 more spaces call cout ;and 6 to allow for backspaces djnz $-3 pop af ;result from justify: jr c,start2 ;proceed if justified ld a,(override) ;or if overridden by command line or a jr nz,exit2 ;no override instruction start2: ld a,(inquiry) ;did they only want to see space? or a jr z,exit2 ;yes, so they've seen, so exit ld a,(fcb1) ;get disk select dec a ;0=A: push af ;save disk call freset ;reset before we start ld a,(justfl) or a push af call nz,compact ;do the damage call closlbr pop af call nz,truncate ;do even more damage pop af ;get disk select call freset ;disk reset again (bdos function 37) xor a jr exit abort: call lpfn ;show file name call eprint db cuss,' is too large to handle.' ld a,1 jr exit exit1: call eprint db 'Error opening ',0 call lpfn ;show file name ld a,2 jr exit exit2: call eprint db bs,bs,bs,'not compacted',0 xor a exit: ld hl,z3flag inc (hl) dec (hl) call nz,puter2 push af ld a,(justfl) ld hl,override or (hl) jr nz,exit3 call eprint db bs,bs,bs,'sorted & checked',0 exit3: ld a,(disk) ;get entry disk call setdsk ;and re-select call retusr ;set original user area pop af or a jr nz,exith call eprint db cr,lf,'Contents: ',0 ld hl,(cntact) ld a,l or h jr z,exit4 dec hl exit4: call prnmbr call eprint db ' active member',0 scf call plural ld hl,(cntdel) call prnmbr call eprint db ' deleted member',0 scf call plural ld hl,(cntopn) call prnmbr call eprint db ' open member slot',0 or a call plural exith: ld sp,(stack) ;set original stack location ret ;return to ccp subttl identification message and command syntax ; No mystery here. Say who is doing this. If ZEX is running, it ; probably means CL was invoked by a ZFiler macro, in which case ; it would be neater not to print the banner every time. signon: ld a,(z3flag) ;non-zero of Z3 running or a ;non-Z3 systems don't have ZEX call nz,getzrun ;any ZEXual activity? ret nz ;skip the signon message call eprint db 'CL (Compact Library), Version ' db version/10+'0','.',version mod 10+'0' db cr,lf,0 ret ; Help the user with command syntax help: call eprint db 'Syntax:',cr,lf,0 call clfnam ld b,19 ld a,space call cout djnz $-3 call eprint db 'compact filename',cr,lf,0 call clfnam ld a,'?' call cout ld b,18 ld a,space call cout djnz $-3 call eprint db 'report free space',cr,lf,0 call clfnam ld a,'Z' call cout ld b,18 ld a,space call cout djnz $-3 call eprint db 'force compact',cr,lf,0 call clfnam call eprint db '-afn1[,afn2,...] delete members',0 jp exith clfnam: call eprint db ' ',0 ld a,(z3flag) or a call nz,getefcb jr nz,gotefcb ld hl,clname-1 gotefcb: ld b,8 namelp: inc hl ld a,(hl) and 7fh cp space call nz,cout djnz namelp call eprint db ' [DU:]filename[.LBR] ',0 ret clname: db 'CL ',0 subttl environmental check for operating reqirements ; Check disk format to determine if ; CL can operate successfully. Return C if we must exit. ; This entry point is called from OPENLBR after the file control ; block has been initialized. If the file is on DosDisk, the ; word at fcb+16 is 0fdfdh. environ2: ld hl,(fcb1+16) ;check for DosDisk files ld bc,0fdfdh ;after file is open or a sbc hl,bc jr nz,environ3 ;not DosDisk signature call eprint db cuss,' file is on DosDisk',0 scf ret environ3: or a ;clear carry ret ;file is not on DosDisk subttl perform the compression ; Read first physical member until buffer full or end of member; ; record the number of sectors read and the current position ; within the file. Beginning after the directory (directory is ; not compressed), write out the same number of sectors; accumulate ; number of sectors written in RETAIN. compact: ld ix,(list) ;ptr to list entry compact1: push ix pop bc ;ptr to list entry ld hl,12 ;offset to offset high byte add hl,bc ;HL ptr to offset high byte ld b,(hl) dec hl ld c,(hl) ;BC offset to member push bc ;push offset to member ld bc,(retain) ;get current write ptr ld (hl),c ;replace the one in the list inc hl ld (hl),b inc hl ;ptr to length ld c,(hl) inc hl ld b,(hl) ;BC length of member ld a,b or c ;check for zero length member jr z,compact0 ;move to next entry compact6: ld hl,(bptr) ;HL ptr buffer call setdma ex de,hl ;DE current DMA pop hl ;HL offset to member compact2: push de ;save DMA ld de,fcb1 call r$read ;read random sector HL pop de push hl ld hl,(bcnt) ;count of sectors in buffer inc hl ld (bcnt),hl ;add one and save pop hl inc hl ;next sector next round dec bc ;or was that the end? ld a,b or c jr z,compact3 ;end of member, exit push hl ld hl,080h ;move DMA up one record add hl,de call setdma ;set DMA from HL ex de,hl ;hold DMA in DE ld hl,(tpaend) ;get top of buffer or a ;clear carry sbc hl,de ;are we there yet? pop hl ;get random record number jr nc,compact2 ;not at tpa end yet, keep reading ; Reached end of member or end of buffer compact3: ld (offset),hl ;store record counter ld (length),bc ;store remaining length ld bc,(bcnt) ;records in buffer ld hl,(bptr) ;base of buffer call setdma ;set DMA from HL ex de,hl ;current DMA into DE ld hl,(retain) ;write offset into lbr ;Write the buffer over current data compact4: push de ;save DMA ld de,fcb1 call r$write ;write record number in HL pop de inc hl ;next record ld a,h or l ;check for rollover jp z,abort ;will have aborted in justify: ;this check is redundant dec bc ;more records in buffer? ld a,b or c jr z,compact5 ;buffer empty, reload push hl ;save record counter ld hl,080h ;move DMA add hl,de call setdma ;set DMA from HL ex de,hl ;save current DMA in DE pop hl ;get record number jr compact4 ;write the next record ; Buffer empty; save counters and reload compact5: ld (bcnt),bc ;re-initialize (bc is zero) ld (retain),hl ;save sectors written call happy ;keep the user entertained ld hl,(offset) ;read ptr ld bc,(length) ;remaining length push hl ;needed on stack at compact6 ld a,b or c ;unless zero jr nz,compact6 ;continue with present member compact0: pop hl ;clear stack compact7: ld de,entsize ;advance to next list entry add ix,de ld a,(ix+0) ;check for list terminator or a jp nz,compact1 ;start again with next member ret ;NC is no error subttl de-allocate unused sectors from file ; Read the entire directory doing our own searches for entries ; matching the file we compressed. Calculate the filesize ; represented by each directory entry, delete those we no longer ; need (e5), and adjust the one entry which overlaps what we wish ; to keep and what we don't. truncate: ld hl,tbuff ;get DMA under control call setdma ld de,fcb1 call f.first ;get first occurance of our file jr z,truncat3 ;not found? truncat1: ld d,0 ld e,a ;DE ptr to directory entry push de pop ix ;IX ptr to directory entry ld a,(ix+14) ;s2 and 0fh ;should be 03fh, but will overflow rrca ;at 8Meg rrca rrca rrca ;*2^4 ld h,a ld a,(ix+12) ;ex and 1fh rrca ;/2 ld l,a ;save in l and 0fh ;low 4 bits belong to h or h ld h,a ld a,l ;recover from l and 080h ;final bit is for l ld l,a ld a,(ix+15) ;rc push af ;save rc and 7fh or l ;stray records into l ld l,a ;HL contains record count pop af ;get rc ld bc,80h and 80h ;check high bit of rc jr z,$+3 add hl,bc ;add another 80h sectors or a ld bc,(retain) ;count of records to retain sbc hl,bc ;compare current to what we're seeking add hl,bc ;restore HL jr c,truncat2 ;earlier extent than we want, keep it push hl ld hl,(extent) ;records in one extent dec hl ;make a sort of extent mask ld a,l or c ld c,a ;or HL with BC ld a,h or b ld b,a inc bc ;BC is upper limit of extent we want inc bc ;plus one pop hl ;refresh HL sbc hl,bc ;is HL still larger? add hl,bc ;restore it jp c,release ;here's the tricky part ;wherein we re-distribute blocks ex de,hl ;we delete this entry altogether ld (hl),0e5h ;cp/m specified delete "user" ex de,hl truncat4: ld hl,writef ;set flag to re-write sector inc (hl) truncat2: ld de,fcb1 call f.next ;find next entry truncat3: jr c,truncat5 ;non-recoverable error jr nz,truncat1 ;get next block directory ret ; The following is effected in the event of a bios read or ; write error. We print or dump everything we have and hope ; the user can straighten things out. Here's hoping this is ; wasted effort. truncat5: call eprint ;fess up db cuss,cr,lf db ' BIOS error!',cr,lf,space,0 ld a,(writef) ;if this isn't reset yet or a ;it was a write error jr nz,truncat6 call eprint ;else it was read error db 'read',0 jr truncat7 truncat6: call eprint db 'writ',0 ;bad bad truncat7: call eprint db 'ing sector ',0 ld hl,(sector) call phldc ;print sector number call eprint db ' of track ',0 ld hl,(track) ld de,(off) or a sbc hl,de call phldc ;print track number call eprint db ' (physical track ',0 add hl,de ;restore physical track call phldc call eprint db ')',cr,lf,0 ld hl,tbuff ;dump the directory sector jp dump ;jp=call!ret ; Now release unneeded blocks. Determine how many blocks to ; nop fill by subtracting the number of sectors to retain from ; the number represented in this directory entry (passed in HL), ; then "dividing" that figure by the disk block size. First we ; ensure that HL is a multiple of the block size. ; Blocks may require one byte or two bytes to designate. The ; only clue we have/need is the high byte of the dsm; if that is ; non-zero, use two bytes. ; On exit from this routine, calculate the new RC, EX, and S2. release: ld a,(blm) ;get block mask ld b,a ;save and l ;even already? ld a,b jr z,$+5 ;even block already, skip or l ;combine with records in this entry ld l,a ;back to HL inc hl ;rounded up to next block xor a ;clear carry, clear accumulator ld bc,(retain) sbc hl,bc ;HL contains records to delete ld bc,(blksize) ;how many of these do we dump? release1: sbc hl,bc ;subtract one block inc a ;increment block counter jr nc,release1 dec a ;any blocks to remove? jr z,release3 ;no, just reset rc, ex, and s2 ld b,a ld a,(dsm+1) ;high byte of bios' dsm ld c,a ;keep this in c ld hl,31 ;offset to last block number add hl,de ;DE still fcb ptr xor a ld e,a ;in case dsm is <256 release2: ld d,(hl) ;pick up block in DE, high byte ld (hl),0 ;zero out directory block number dec hl ld a,c ;high byte of bios' dsm or a ;check dsm jr z,$+6 ;only one byte per block ld e,(hl) ;low byte ld (hl),0 dec hl ld a,d or e ;is that a block number? jr z,release2 ;no, skip djnz release2 ;loop until ctr expires release3: ld a,(retain) ;get low byte of retained records push af ;save low byte and 7fh ;take low 7 bits ld (ix+15),a ;put new rc into this entry pop af ;get low byte of retained records and 80h ;keep high bit ld b,a ;in b ld a,(retain+1) ;get high byte of retained records push af and 0fh ;keep low 4 bits or b ;combine with high bit of low byte rlca ;1fh max ld (ix+12),a ;set new ex pop af ;get high byte of retained records and 0f0h ;keep high 4 bits rrca rrca rrca rrca ld (ix+14),a ;set new s2 jp truncat4 ;re-enter truncation routine ; Our ostensible purpose is to find the first matching entry in ; the directory. First, though, initialize XLT, and EXTENT and ; DSEC figures from dpb information. f.first: push de ld a,(fcb1) ;get disk select dec a ;0=A: ld c,a set 0,e ;not the first select call seldsk ld hl,(bioshl) ;returned by bios ld de,xlt ;HL ptr to dph ldi ;copy address of translate table ldi pop de ld hl,(blksize) ;space allocated by one block add hl,hl add hl,hl add hl,hl ;*2^3 ld a,(dsm+1) ;disk sector mask high byte into a or a ;zero if 8-bits name a block jr nz,$+3 ;not zero if 16-bits name a block add hl,hl ;*2^4 ld (extent),hl ;space allocated by one dir entry ld hl,(drm) ;disk directory mask into HL inc hl ;count the 0 sector ld b,2 ;divide by 4 (2^2) or a ;clear carry rr h rr l djnz $-5 ld (dsec),hl ;set number of directory sectors ld hl,(off) ;starting track offset ld (track),hl ;first track of directory jr f.next1 ;read the first sector ; "Get" next matching entry. This may already be in the buffer. ; First check the remaining entries in the buffer, then, if ; necessary, read a new sector of the directory. Function is ; equivalent to syslib's f$next. f.next: ld a,(tptr) ;last ptr into tbuff add a,020h ;next dir entry jr z,f.next1 ;need another sector ld (tptr),a ld l,a ld h,0 ;DE ptr to fcb1 ld b,(hl) ;check user area ld a,(user) cp b jr nz,f.next ;not right, skip push de ;@fncmp changes DE and HL inc hl inc de ld b,11 ;compare filename,ext call @fncmp ;7 bits, no wildcards pop de jr nz,f.next ;no match, loop ld a,(tptr) ;restore all-important offset or a ;set NZ ret ; have exhausted the four entries of the current directory sector ; looking for a match; must read another sector. before reading, ; be sure to write this sector back to disk if we want to save it. ; check for end of track and increment if neccesary. check for ; end of directory. ; My old CP/M manual says disks with 0000h for XLT do not perform ; logical to physical translations (thus no translate table ; address). Bridger Mitchell says one should "Always call the ; bios sectran, for the odd bios that maps 1...n to 0...n-1 without ; showing an xlate table in the dph." f.next1: ld a,tbuff-020h ld (tptr),a ;store new ptr into buffer ld a,(writef) ;do we want to save this sector? or a call nz,write ;yup, write it or a scf ;C for error ret nz ;error on write? ld (writef),a ;and reset write flag push de ld bc,(track) ;last track read ld de,(sector) ;last sector read ld hl,(spt) ;more sectors on this track? or a sbc hl,de ;Z if no more (hold flag) ex de,hl ;sector into HL inc hl ;pt to next sector pop de jr nz,$+6 ;now use flag inc bc ;increment track ld hl,1 ;reset sector ld (track),bc ;save track ld (sector),hl ;save sector ld hl,(dsec) ;number of sectors in directory ld a,h or l ret z ;Z for directory exhausted dec hl ;subtract the next one ld (dsec),hl call settrack ld bc,(sector) ;number of desired sector dec bc push de ld de,(xlt) ;ptr to translation table call sectran ;logical to physical translation ld hl,(bioshl) ld b,h ld c,l ;move result to BC pop de call setsect ;set sector for read call read or a jr z,f.next ;check for matching entries scf ;C for non-recoverable error ret subttl evaluate the need for compression ; Going through the list, add offset and length of first member. ; Subtract this from the offset of the next member. Accumulate ; difference in WASTE. Obtain disk blocking factor from bdos and ; subtract WASTE from blocking. On return, C will indicate free ; sectors add up to more than one block or more than the number of ; sectors used in the last block; compression will be beneficial. justify: ld bc,0 ;clear accumulator ld hl,(list) push hl pop ix ;IX ptr to first entry ld de,entsize ;DE offset to next entry add hl,de push hl pop iy ;IY ptr to second entry ld a,(ix+0) ;check for list terminator or a jr z,justify2 ;no list justify1: ld l,(ix+11) ld h,(ix+12) ;HL index of first member ld e,(ix+13) ld d,(ix+14) ;DE length of first member add hl,de ;HL index to end of first member ld a,(iy+0) ;check for list terminator or a jr z,justify2 ld e,(iy+11) ld d,(iy+12) ;DE index to second member ex de,hl or a sbc hl,de ;HL free space between members add hl,bc ld b,h ld c,l ;BC accumulator for free space ld de,entsize ;length of a list entry add ix,de ;move ix to next entry add iy,de ;move iy to next entry jr justify1 justify2: ld de,fcb1 ld a,23h ;compute file size call dos ex de,hl ;end of final member into DE ld hl,(fcb1+33) ;file size into HL ld (fsize),hl ;save for later ld a,(fcb1+35) ;check last byte for overflow or a jp nz,abort ;too big for us to handle sbc hl,de ;free space on end of file add hl,bc ;add previous waste value ld b,h ld c,l ;copy to BC ld (waste),hl ;store free space ld a,1fh call dos ;get address of disk parameters push bc ld hl,(bdoshl) ;ptr to dpb base ld de,spt ;ptr to disk param storage ldi ldi ;HL ptr to bsh ldi ;HL ptr to blm ld a,(hl) ;blm into a ld bc,dparms ;number to copy ldir ;get these to local storage ld l,a ;blm into l ld h,b ;HL is blm (B = 0) pop bc ;get back waste inc hl ;HL is sectors per block ld (blksize),hl ;save this figure or a ;clear carry (DOS #31 may not!) sbc hl,bc ;if waste is larger add hl,bc ;restore sectors per block first ret c ;we know we can gain from compression xor a ;use acc to count extents ex de,hl ;blocking into DE ld hl,(fsize) ;get file size again inc a ;incr extent counter sbc hl,de ;subtract block by block jr nc,$-2 ;until we overshoot dec a ;back off one extent add hl,de ;get positive value again or a sbc hl,bc ;subtract waste again ret subttl locate the library and open it ; Find and open the library. Build a list of library members along ; with their offset and length. Sort the list ascending by offset ; (first physical member must be first in list). Return C on error ; of any kind. Called with DE pointing to FCB1. openlbr: ld hl,'BL' ;force filetype ld a,'R' ld (fcb1+9),hl ;blr ld (fcb1+11),a ld a,(de) ;get drive select or a jr nz,$+7 ;set, skip ahead call getdsk ;not set, get current disk inc a ;adjust for drive select ld (de),a ;lock it in dec a call setdsk ;and select it through bdos ld a,(fcb1+13) ;get user ld (user),a ;save it call savusr ;go there call f$open ;is it there? scf ret nz ;no, quit call environ2 ;check for DosDisk ret c ;found it, quit ld hl,tbuff call setdma ;read first sector to default buffer ld l,h ld (opnrec),hl call r$read scf ret nz ;must be zero length, quit ld a,(tbuff) ld l,8ch ;ptr to index of directory member or (hl) ;(H = 0 from above) inc hl or (hl) inc hl ;ptr to length of directory scf ret nz ;not a library ld de,dirlen ldi ldi ld de,(list) openlbr1: ld hl,80h ;ptr ld b,4 ;four files per directory sector openlbr2: push hl call cntdo pop hl ld a,(hl) ;active entry? or a ld a,b jr nz,openlbr3 ;this one's bad, skip it ld a,(delbuf) or a ld a,b jr z,openlbr4 del: push hl push de push bc ex de,hl inc de ld hl,delbuf ld a,(de) sub space jr nz,del1 dec a jr del2 del1: ld a,',' cpi jr nz,del2 push de push hl ld b,11 call @afncmp pop hl pop de ld bc,11 add hl,bc jr nz,del1 ld hl,(cntact) dec hl ld (cntact),hl call incdel call pfn2 ld a,0feh ld (delflg),a ;deletion flag for current record dec de ;point to status byte ld (de),a ;mark as deleted for safety call eprint ;inform user db ' deleted.',cr,lf,0 xor a ;A = 0, Z ld (override),a ;stipulate directory compact del2: pop bc pop de pop hl ld a,b ;entry counter to A jr z,openlbr3 openlbr4: push hl inc hl ;ptr to filename ld bc,entsize ldir ;copy directory info to list pop hl openlbr3: ld bc,20h ;move to next member add hl,bc ;HL ptr to next member ld b,a ;entry counter to B djnz openlbr2 ;loop through this record ld hl,(dirlen) dec hl ld (dirlen),hl ;decr sector count of directory ld a,h or l ;see if there are more jr z,openlbr5 ;no, that was it push de ;save list ptr ld de,fcb1 ld hl,(opnrec) ;get current record number ld a,(delflg) ;did we delete? or a call nz,r$write ;if so, write back record jr nz,openerr ;trap any error ld (delflg),a ;reset local delete flag inc hl ;next record number ld (opnrec),hl ;store it & call r$read ;read the next record openerr: pop de jp z,openlbr1 ;extract files from this record scf ret ;read error (NZ + C) openlbr5: ex de,hl ;ptr to end of library in HL ld (hl),a ;set terminator (A = 0) inc hl ld (bptr),hl ;buffer may begin here ; Fall through to sort list entries by their indices. Pt to first ; entry, compare its index to each of the later entries in the list. ; At the end of the first round, the lowest index is at the top of ; the list; other entries are still out of order. Pt to the second ; entry and go through the list again; the second lowest index will ; be in the second list position at the end of the second pass. ; The following sort routine has no error detection. We should ; be monitoring for matching indices and...what?...abort the ; compression if found? ;sort: ld ix,(list) ld a,(ix+0) ;check for terminator or a ret z ;nothing in list sort0: push ix ;IX ptr to first entry pop iy ld de,entsize add iy,de ;IY ptr to second entry ld a,(iy+0) ;check for end of list or a ret z ;we be done sort1: ld h,(ix+12) ;high byte of index ld l,(ix+11) ;low byte of index ld d,(iy+12) ;high byte of index ld e,(iy+11) ;low byte of index or a sbc hl,de ;which came first jr c,sort3 ;DE is larger, comes later, skip swap push ix ;swap entries pop hl ;HL ptr first entry (high index) push iy pop de ;DE ptr to second entry (low index) ld b,entsize sort2: ld a,(de) ;shuffle ld c,a ld a,(hl) ld (de),a ld (hl),c inc hl inc de djnz sort2 sort3: ld de,entsize ;bump high ptr add iy,de ld a,(iy+0) ;check for end of list or a jr nz,sort1 ;not at end, loop add ix,de ;bump low ptr jr sort0 subttl re-write the library directory and close file ; Write a new library directory from the information in the list. ; Any previously deleted members have now been overwritten, so ; their directory entries must be removed (they may not be un- ; deleted now). closlbr: ld hl,tbuff call setdma ld l,0 ;read 1st record of lbr (HL = 0) ld (cntopn),hl ;zero out all three counts now ld (cntdel),hl ld (cntact),hl ld de,fcb1 ;for directory entry call r$read ld hl,(tbuff+14) ;get length of dir in sectors add hl,hl add hl,hl ;get number of dir entries ex de,hl ;number of entries into DE ld hl,(bptr) ;copy buffer is free now closlbr1: ld (hl),0ffh ;mark it unused inc hl ld b,11 ld (hl),space ;init filename.typ inc hl djnz $-3 ld b,20 ld (hl),0 ;fill out dir with 00h inc hl djnz $-3 dec de ;decr count of entries ld a,d or e ;Z if we're through jr nz,closlbr1 ;do another ld de,(bptr) ;ptr to new directory ld hl,(list) jr clostmp closlbr2: xor a ld (de),a ;mark entry active push de inc de ld bc,entsize ldir ;copy list to directory pop de closlbr3: push hl ld hl,20h add hl,de ex de,hl pop hl clostmp: ld a,(hl) ;check for end of list or a jr nz,closlbr2 ;copy another member to dir ld hl,(bptr) ;pt to dir entry again ld de,14 ;offset to dir length add hl,de ld c,(hl) inc hl ld b,(hl) ;BC is length of dir inc hl ld d,h ld e,l ;copy ptr to DE ld (hl),0 ;HL now ptr to crc inc hl ld (hl),0 ;zero out the old crc ld h,b ;copy length of dir to HL ld l,c ld b,7 multlp: add hl,hl djnz multlp ;compute HL*2^7 (saves 2 bytes ;compared to previous code) ld c,l ;number of bytes in dir ld b,h ;copy back to BC call crc3clr ;initialize crc-16 push bc ;bytes in dir to stack push de ;pointer to CRC on stack ld de,32 ;length of member entry call divhd ;compute number of records to sort ld b,h ;into BC ld c,l ld hl,(bptr) push hl call sort ;SigiSORT 'em (Shell-Metzner wo/pointers) pop hl ;bptr pop de ;pointer to CRC pop bc ;length in bytes closlbr4: ld a,(hl) ;get a byte from dir inc hl ;pt to next byte call crc3upd ;rotate into crc dec bc ld a,b or c ;see if there are more to go jr nz,closlbr4 ;go around again call crc3done ;get crc into HL ex de,hl ;DE is still ptr to crc storage ld (hl),e inc hl ld (hl),d ;store new crc in directory ld hl,(bptr) ;ready to write it out again call setdma ex de,hl ;last DMA into DE ld hl,14 ;offset to length of dir add hl,de ld c,(hl) inc hl ld b,(hl) ;length into BC ld hl,0 ;start with record 0 closlbr5: push de ;save DMA ld de,fcb1 ;pt to library fcb call r$write ;HL is record number pop de inc hl ;incr record push hl ;save record call cntent ld hl,80h ;bump DMA add hl,de call setdma ex de,hl ;hold last DMA in DE pop hl dec bc ;decr record count ld a,b ;see if that's the end or c jr nz,closlbr5 ;write another record ld de,fcb1 jp f$close ;close library, jp=call!ret ;free at last, free at last subttl entertainment section ; HL contains the number of records just written (or the number in ; the original library if entry is happy2). Print the number of ; Kilobytes this represents so the user will have something to ; watch. happy: push hl push de push bc ld b,6 ld a,bs ;print six backspaces to call cout ;overwrite the last display djnz $-3 jr happy3 ;print xxxxxK happy2: push hl push de push bc ld bc,0803h ;start with three and ;look at 8 characters of the filename ld hl,fcb1+1 ld a,(hl) inc hl cp space ;count it if it's a space jr nz,$+3 inc c djnz $-7 ld b,c ;number of spaces to print ld a,space ;3 plus any in the filename call cout djnz $-3 ld hl,(fsize) ;filesize into HL happy3: ld a,(blm) ;get block mask ld b,a ;save and l ;is it even already? ld a,b ;restore jr z,$+5 ;yes, even, skip or l ;combine with record count ld l,a ;to round up to next block inc hl ;even block ld b,3 ;divide HL by 2^3 xor a ;clear carry rr h rr l djnz $-5 call phldc ld a,'K' call cout pop bc pop de pop hl ret ; Imitate ZPRSFN under CP/M 2.2, except for file ambiguity test ; (returns with Z set if parse is OK). HL, BC, & A destroyed. parse: call fname inc a ret nz ld a,b inc a jr z,parse1 dec a parse1: ld (de),a ld a,c cp '?' jr z,parse2 cp 0ffh jr nz,parse3 parse2: ld a,(tmpusr) parse3: ld hl,13 add hl,de ld (hl),a xor a ret ; Print du:library.LBR from FCB1 and "USER:" ; uses DE and A only, all others preserved lpfn: ld de,fcb1 ld a,(de) add a,'@' call cout ld a,(user) call pafdc ld a,':' call cout inc de jp pfn2 subttl bdos disk/user handling ; SAVUSR stores the current user area and sets the user area passed ; in A; RETUSR restores to the original area. savusr: push af ;preserve flags push af ;save destination call getusr ld (tmpusr),a pop af ;get destination jr savusr1 retusr: push af ;preserve flags ld a,(tmpusr) savusr1: call setusr pop af ;restore flags ret ; GETUSR returns the current user area in A. SETUSR sets the user ; area to the code passed in A. getusr: ld a,0ffh setusr: push de ld e,a ;move code to E ld a,20h ;get/set user code call dos dec a pop de ret ; SETDSK sets the default drive from the code in A (drive A = 0). setdsk: push de ld e,a ld a,0eh call dos ;no return code pop de ret ; GETDSK returns the code of the default disk in A (drive A = 0). getdsk: ld a,19h ;return current disk call dos dec a ret ; BDOS access. Pass function in A. dos: push hl push de push bc ld c,a ;move function code to C call 5 ;call BDOS ld (bdoshl),hl ;save this information pop bc pop de pop hl inc a ;if CP/M error code is 0ffh, ret ;this routine returns Z=error subttl LBR directory evaluation cntent: ld a,(de) call cntdo1 ld hl,32 add hl,de call cntdo ld hl,64 add hl,de call cntdo ld hl,96 add hl,de ; FALL THROUGH cntdo: ld a,(hl) cntdo1: or a jr z,incact inc a jr z,incopn inc a ret nz ; FALL THROUGH incdel: ld hl,(cntdel) inc hl ld (cntdel),hl ret incact: ld hl,(cntact) inc hl ld (cntact),hl ret incopn: ld hl,(cntopn) inc hl ld (cntopn),hl ret subttl Handle Member Counts & Plurals prnmbr: ld a,l or h jp nz,phlfdc call eprint db 'no',0 ret plural: push af dec hl ld a,l or h ld a,'s' call nz,cout pop af ld a,',' jr c,plural1 ld a,'.' plural1: call cout ld a,space call c,cout ret subttl Delete Buffer Init. delini: ld hl,tbuff ld c,(hl) ld b,h ;BC has length (HL =0) dec bc inc hl inc hl ld a,space cpir ret nz ld a,'-' cpir ret nz ld de,delbuf delilp: call fname call sksp ld a,',' ld (de),a cpi ret nz ex de,hl ;buffer pointer to HL ld bc,12 ;offset to next spot add hl,bc ;new pointer in HL and ex de,hl ;back to DE, command line to HL call sksp ;skip any blanks jr delilp ;loop around subttl bios access handling seldsk: ld a,9 jr bios settrack: ld a,10 jr bios setsect: ld a,11 jr bios read: ld a,13 jr bios write: ld c,1 ;directory write ld a,14 jr bios sectran: ld a,16 ; jr bios ; FALL THROUGH to bios: bios: push hl push de push bc push hl ld hl,return ;this routine's return address ex (sp),hl ;on stack push hl push de ld hl,(1) ;get bios vector ld d,0 ld e,a ;DE is vector number dec de ;cold boot is vector 1 add hl,de add hl,de add hl,de ;HL ptr to selected vector pop de ex (sp),hl ret ;call bios return: ld (bioshl),hl ;save reg pop bc pop de pop hl ret dseg dsbegn: ds 0 z3flag: ds 1 ;non-zero if running under ZCPR3 disk: ds 1 ;disk selected on entry user: ds 1 ;user area for library tmpusr: ds 1 ;temporary user area storage inquiry: ds 1 ;flag from command line to prevent compact override: ds 1 ;flag from command line to force compact justfl: ds 1 ;if zero, skip compact and truncate calls delflg: ds 1 ;local member delete flag opnrec: ds 2 ;random record number for "openlbr:" stack: ds 2 ;storage for original stack ptr tpaend: ds 2 ;ptr to end of buffer space list: ds 2 ;ptr to base of list buffer bptr: ds 2 ;ptr to base of copy buffer bcnt: ds 2 ;count of records copied into buffer cntact: ds 2 ;count of active LBR members cntdel: ds 2 ;count of deleted LBR members cntopn: ds 2 ;count of open LBR member slots waste: ds 2 ;free space within library on entry retain: ds 2 ;used space within library after packing fsize: ds 2 ;size of original file blksize: ds 2 ;size of disk allocation block extent: ds 2 ;space controlled by one directory entry xlt: ds 2 ;translation table for this disk spt: ds 2 ;sectors per track bsh: ds 1 ;block shift factor blm: ds 1 ;allocation block mask exm: ds 1 ;extent mask dsm: ds 2 ;storage on this disk drm: ds 2 ;directory entries this disk al0: ds 1 ;low 8 al1: ds 1 ;high 8 cks: ds 2 ;directory check vector off: ds 2 ;number of reserved tracks dparms equ $-blm offset: ds 2 ;read ptr into member when buffer fills length: ds 2 ;remaining length of member when buffer fills dirlen: ds 2 ;temp storage for length of directory tptr: ds 1 ;ptr into tbuff when truncating file length writef: ds 1 ;0=don't re-write this sector dsec: ds 2 ;number of directory sectors on disk track: ds 2 ;track we just set sector: ds 2 ;sector we just read of directory bioshl: ds 2 ;storage for bios return information bdoshl: ds 2 ;storage for bdos return information delbuf: ds 384 ;VERY conservative, for delete FCB's dslen equ $-dsbegn end