;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