; NOTE: This is a copyrighted program released for private,
; non-commercial use ONLY.  Please read copyright statement
; starting on line number 44 for details.

; Program: LPUT
; Author: Bruce Morgen
; Version: 1.0
; Date: November 25, 1986

;LPUT.Z80	11/25/86

; The godfather of LPUT is Nick DeWolf, inventor of the
; remarkable ON! Computer - probably the finest Z80-based
; personal computer ever made.  Nick suggested that users
; who were not computer enthusiasts would never use LBR
; files because existing LBR utilities like LU and NULU
; made the process of creating LBRs and filling them with
; member files too intimidating for non-techies.  Thanks
; for the inspiration, Nick.  I hope users of the ON! and
; other Z-System compatible computers enjoy the program.
;
; ON! Systems, Inc., manufacturers of the ON! system, has
; done more to foster the creation of quality utility
; software then any other hardware vendor in recent memory.
; Their product is superb and deserves the support of the
; user community.  For more information about the ON!,
; call Bill Elliot at 312-680-4680.
;
; Please direct communications about LPUT itself to me:
;
; 		Bruce Morgen
;		North American One-Eighty Group
;		P.O. Box 2781
;		Warminster, PA  18974
;
;		Voice phone:
;		215-443-9031 (East Coast business hours ONLY!)
;
;		Electronic mail:
;		Lillipute Z-Nodes (312-649-1730, 312-664-1730)
;		Drexel Hill NorthStar (215-623-4040)
;_______________________________________________________________
;
; LPUT is copyright 1986 by the author.  It is released to
; the user community in source and object form for non-
; commercial use only.  Permission is hereby given to use
; and/or modify it in any way that you see fit.  The author
; retains exclusive rights to public release of LPUT and
; asks that any improvements to the program or adaptations
; for other operating environments not be distributed in
; any way without his consent.  Furthermore, any commercial
; use of LPUT without the express written agreement of the
; author is specifically prohibited.  This prohibition
; includes sale of the program in any form except as part
; a user group library disk selling for not more than $20
; copying and handling fee or as a download offering on
; remote access systems with no fee charged beyond normal
; subscription and/or access rates.  LPUT may not be sold
; or licensed by any person other than the author or his
; authorized agent(s).  As of August 19, 1987, the only
; such agent is ON! Systems, Inc., Libertyville, IL, USA.
; The author warrants that LPUT comprises his original
; work and as such is protected by the copyright laws of
; The United States of America and applicable international
; copyright regulations.  No other warranty is expressed or
; implied.
;
; (signed) Bruce Morgen			August 19, 1987
;________________________________________________________________
;
; Version 1.8 November 15, 1989 by Howard Goldstein
; This version fixes a bug introduced in version 1.7.  The bug 
; was causing LPUT to create totally corrupt LBR's under Z3PLUS.  The 
; problem was in the DATER routine.  Looking toward the future, I also
; made a small change that will allow LPUT to pick up imbedded date
; stamps from LZH encoded files.
;
; Version 1.7 September 26, 1989 by Howard Goldstein
; The major change in this version was to incorporate the new DSLIB
; routines that allow it to pick up member files' datestamps directly
; from ZSDOS.  This also fixes a bug that showed up under ZSDOS:
; Sometimes a member file's "modified" stamp would be updated as it
; was being added to the LBR.  I did a bit of crunching to keep the
; code under 6k.  The major change in this regard was to eliminate
; SYSLIB's FILLB and use a much shorter inline routine.
; The program was linked with the Version 4 libraries.  SYSLIB
; now contains Bruce's table-driven CRC routines so the separate REL
; file is no longer included.  LINKAGE ORDER IS:
; WILDEX, MYSORT, UNDATE, DSLIB, Z3LIB, SYSLIB.
;
; Version 1.6B September 27, 1988 by Bruce Morgen
; Retaining Michal's excellent work with modify dating, I put in
; some code to allow a trailing parameter of "+nn" to leave "nn"
; extra LBR directory entries beyond what is required for the
; member file list.  This parameter is ignored if the target LBR
; already exists or if a "/nn" occurs first in the command tail.
; Following the laudable trend instigated by Howard "Mr. Beta"
; Goldstein, LPUT now uses the Z33/Z34 CCP parser whenever it's
; available.
;
; Version 1.6 August 27, 1988 by Michal Carson
; A very few adjustments to store last mod date in library
; directory along with cre date.  After Creation date is
; evaluated and stored, Modification date is moved into the labels
; accessed by @UDCVT, evaluated and stored.  This means that the
; mod date will be displayed.

; Version 1.5A March 29, 1988 by Bruce Morgen
; Fixed problem with null dates and midnights in CR23ed files
; creating anamolous LBR date values. Jay Sage has suggested
; that the DS Modify date is really more authentic than the
; Create date for LBR use, supplied LPUTMOD.HEX to implement
; that preference - however, be aware that LBREXT26 will make
; the LBR date the Create date on extraction.

; Version 1.5 March 16, 1988 by Bruce Morgen
; Full DateStamper support, including imbedded dates in
; CRUNCH23Ded files, plus a few minor tweaks.  Reverted to
; old Type 1 format as a high org would screw up performance
; badly due to constricted buffer space.

; Version 1.4 June 28, 1987 by Bruce Morgen
; Fully-buffered file input, more random reads to survive
; ZRDOS 1.7 and later peculiarities, no more attribits in
; LBR directory entries, WILDEX lists now sorted via Sigi's
; (modified, of course) MYSORT.  LPUT will now create a new
; LBR with the correct size directory if the specified one
; does not exist.  Moreover, the special syntax:
;		LPUT newlbr /nn
; where xx is a number will create a beautiful but entirely
; empty LBR with nn entries.  Added NEWLBR flag to minimize
; calling the CLEAN routine.  SYSLIB CRC routines discarded
; in favor of a look-up table ala' DISK7, CHEK15, PPIP, etc.
; Thanks to Irv Hoff for pointing out the speed advantage of
; that approach.  This is the ON! Systems release version.
; (Tweak tweak, fiddle fiddle, faster faster....)

; Version 1.3 May 29, 1987 by Bruce Morgen
; Handles file lists just like LGET.  Really, it does...

; Version 1.2 May 28, 1987 by Bruce Morgen
; Updated to ZCPR33/BGii Type 3 format.  Coded internal PRNDU
; routine calling SYSLIB, deleted FENV call and external, use
; DSEG for new LIBs, Z80fy and DSEGify WILDEX module, put in
; in-line code to avoid the LBR eating itself as a member.

FALSE	EQU	0
TRUE	EQU	NOT FALSE

M80	EQU	FALSE		; Using Microsoft Macro 80
				; Assembler? Otherwise false.

FCB	EQU	05CH		; Default file control block
FCB2	EQU	06CH		; The other one
TBUFF	EQU	080H		; Default DMA buffer
CR	EQU	0DH		; ASCII Carriage return
LF	EQU	0AH		; ASCII Linefeed
BEL	EQU	07H		; ASCII Console Bell

	ENTRY	$MEMRY,COUT,@DCFLD
	ENTRY	DATER
	ENTRY	YEAR,MONTH,DAY

	EXTRN	WILDEX,SORT,@UDCVT; Modified Sigi Kluger modules

; Z3LIB stuff (used version 4 of Z3LIB)
	EXTRN	Z3INIT,Z3LOG,PUTER2,GETMSG,ZFNAME,GETEFCB
	EXTRN	Z33CHK,Z33FNAME,GZMTOP

; DSLIB stuff
	EXTRN	TIMINI,RCLOCK,GSTAMP,DOSTYP

; SYSLIB stuff (Note: "BDOS" is a SYSLIB routine, not 0005h,
;		used version 4 of SYSLIB)
	EXTRN	CRLF,EPSTR,EPRINT,PFN2,PAFDC,PHLFDC
	EXTRN	F$OPEN,F$READ,F$CLOSE,R$READ,R$WRITE
	EXTRN	F$MAKE,F$WRITE,INITFCB
	EXTRN	PUTUD,GETUD,RETUD,LOGUD,GETFS,GETRR
	EXTRN	DPARAMS,DFREE,DIVHD,COMPHD,SETDMA
	EXTRN	CLINE,SKSP,EVAL10,BOUT,BIST,BIN,BDOS

; Look-up table based CRC module ala' DISK77, CHEK15, PPIP, etc.
; (Now part of SYSLIB)
	EXTRN	CRC3INIT,CRC3CLR,CRC3UPD,CRC3DONE

	 IF	M80
	.Z80			; Needed by M80 only
	 ENDIF


LPUT:	JP	START
	DB	'Z3ENV',1	; Type 1 external environment.
Z3EADR:	DW	0e050h
START:	LD	(STACK),SP
	LD	HL,($MEMRY)
	INC	H
	LD	SP,HL
	LD	A,L
	OR	A
	JR	Z,CRCPAG
	INC	H
	LD	L,0
CRCPAG:	LD	(CRCTBL),HL	; Store address
	CALL	CRC3INIT
	CALL	PUTUD		; Store current DU via SYSLIB.
	LD	HL,TBUFF
	CALL	CLINE		; Stow command tail as a string.
	PUSH	HL		; Save buffer start for later
	LD	A,(FCB2+1)
	CP	20H
	JR	Z,NOEXTR
	LD	A,'+'		; Prepare to search for extras
	LD	BC,0FFH		; 255-byte range, B = 0
	CPIR			; Scan ahead
	JR	NZ,NOEXTR	; NZ means no "+" anywhere
	DEC	HL		; De-bump to end of filenames
	DEC	HL
	LD	A,(HL)		; Get the byte
	CP	21H		; Test for space character
	JR	NC,NOEXTR	; If not, it's not extras
	LD	(HL),B		; Otherwise, null-terminate
	INC	HL		; Go back to alleged number
	INC	HL
	LD	B,H		; Copy pointer to BC
	LD	C,L
	CALL	EVAL10		; Evaluate as decimal
	LD	A,(HL)		; Test terminator, clear carry
	OR	A		; Must be a null
	JR	NZ,NOEXTR	; Otherwise no extras
	SBC	HL,BC		; Make sure EVAL10 pointer moved
	JR	NZ,YSEXTR	; It did if NZ
NOEXTR:	LD	DE,0		; No extras if we're here
YSEXTR:	LD	(EXTRA),DE	; Save for MKNLBR
	POP	HL		; Get back buffer start in HL
	LD	D,H		; Copy buffer start to DE.
	LD	E,L
	XOR	A		; Search for null terminator.
	LD	BC,0FFH		; 255 byte range in buffer.
	CPIR			; Do it Z80-style.
	DEC	HL		; Back up over null.
	LD	(CMDEND),HL	; Store address for later.
	EX	DE,HL		; Get buffer start back into HL.
	LD	A,','		; Search for input file delmtr.
	LD	BC,33		; Reasonable range limit.
	CPIR
	DEC	HL
	JR	Z,FNDCMA	; If it was a comma, use it.
	EX	DE,HL		; Otherwise use end of string.
FNDCMA:	LD	(CMDLIN),HL
	LD	HL,(Z3EADR)	; Get environment address or 00.
	LD	A,L		; Test for valid environment.
	OR	H
	JR	NZ,OKZ3		; Z flag set indicates failure.
	CALL	EPRINT
	DB	'Non-ZCPR3 systems',0
ABTXIT:	LD	HL,ABTMSG	; Share ASCII for space savings.
	CALL	EPSTR
	JP	DIROK

OKZ3:	CALL	Z3INIT		; Pass ENV to Z3LIB.
	CALL	EPRINT
	DB	'LPUT, Version 1.8',0
	LD	DE,FCB+1
	LD	A,(DE)
	CP	20H
	JR	Z,HELP
	CP	'/'
	JP	NZ,CHKAMB
HELP:	CALL	EPRINT
	DB	CR,LF
	DB	'Syntax:'
	DB	CR,LF,' ',0
	CALL	GETEFCB
	JR	Z,NOEFCB
	LD	B,8
EFCBLP:	INC	HL
	LD	A,(HL)
	AND	7FH
	CP	' '
	CALL	NZ,BOUT
	DJNZ	EFCBLP
	JR	HELP1
NOEFCB:	CALL	EPRINT
	DB	'LPUT',0
HELP1:	CALL	EPRINT
	DB	' dir:lbrfile [dir:afn1.typ,dir:afn2.typ...etc[ +nn]]'
	DB	CR,LF
	DB	'Omitting the input filespec results in an'
	DB	CR,LF
	DB	'LBR directory format check and CRC update.'
	DB	CR,LF,LF
	DB	'If "lbrfile" is not found, LPUT will create it.'
	DB	CR,LF
	DB	'In that case, an input filespec of "/nn" makes an'
	DB	CR,LF
	DB	'empty LBR for "nn" members and an optional trailing'
	DB	CR,LF
	DB	'"+nn" creates one with "nn" extra member slots.'
	DB	0
	JP	DIROK

CHKAMB:	CALL	AMBCHK
	JR	NZ,TSTMSG	; No match means OK.

AMBFND:	CALL	EPRINT
	DB	CR,LF,'No ambiguous LBR filenames allowed.',BEL,0
	JP	ERRJP

TSTMSG:	CALL	GETMSG		; Do we have a message buffer?
	JR	NZ,MSGBOK	; Abort if not.
	CALL	EPRINT
	DB	CR,LF,'Systems without ZCPR3 message buffer',0
	JP	ABTXIT		; Print rest of message and abort

MSGBOK:	XOR	A		; Zero in A
	LD	(MEMDIR+1),A	; Clear this, doubles as a flag.
	LD	(NEWLBR),A	; Init. to "existing" LBR.
	CALL	PUTER2		; Poke into program error flag.
	DEC	DE		; Point at requested library.
	CALL	Z3LOG		; Log in temporarily.
	CALL	DPARAMS		; Extract and store DPB data.
	CALL	RETUD		; Retrieve drive and user area.
	LD	(LBRDU),BC	; Store.
	EX	DE,HL		; Stash FCB in HL.
	LD	DE,LBRFCB	; Internal LBR FCB to DE.
	PUSH	DE		; Save on stack.
	LD	BC,9		; Move only up to filetype.
	LDIR			; Do it.
	EX	DE,HL		; HL points to LBR FCB filetype.
	LD	(HL),'L'	; Plug in L B R.
	INC	HL
	LD	(HL),'B'
	INC	HL
	LD	(HL),'R'
	POP	DE		; Get back LBR FCB start.
	CALL	INITFCB		; Initialize for reentrance.
	CALL	F$OPEN		; Anybody home?
	JR	Z,LBRFND
	LD	A,(FCB2+1)
	CP	20H
	JR	Z,NOINPF
	LD	BC,(LBRDU)
	CALL	EPRINT
	DB	CR,LF,'Making library: ',0
	CALL	PRNDU
	INC	DE
	CALL	PFN2
	LD	A,','
	CALL	BOUT
	LD	A,0FFH
	LD	(NEWLBR),A
	DEC	DE
	CALL	MKNLBR
	JR	NZ,LBRFND
NOINPF:	CALL	EPRINT
	DB	BEL,CR,LF,'No input file(s), aborting!',0
	JP	ERRJP

LBRFND:	CALL	GZMTOP		; Find top of tpa
	LD	A,H		; ...using extended environment if available
POKTOP:	LD	(RAMTOP),A
	LD	(RAMDMA+1),A	; Store as buffer ptr. page.
	LD	A,(FCB2+1)
	CP	20H
	JR	Z,NOMEMS
	OR	A
	JR	NZ,LSIZER
NOMEMS:	LD	HL,(CRCTBL)
	INC	H
	INC	H
	LD	(RAMBOT),HL
	OR	A
	JP	Z,DODIR
NMEMSG:	CALL	EPRINT
	DB	CR,LF,'No input file specified, checking LBR'
	DB	CR,LF,'directory format & updating its CRC.',0
	JP	DODIR

LSIZER:	CALL	GETFS		; Size 'er up.
	JP	NZ,ERROR	; VERY unlikely, but who knows?
	LD	A,L
	OR	H
	JP	Z,FORMER	; Don't permit zero-length LBRs.
	LD	(LBREND),HL	; Otherwise store as end marker.
	LD	DE,FCB2		; Point at requested new member.
	CALL	GETUD		; Reassert original D/U.

RENTER:	CALL	Z3LOG		; Log in as per Z3.
	CALL	RETUD		; Retrieve drive and user area.
	LD	(MEMDU),BC	; Store that locally.
	EX	DE,HL		; FCB pointer to HL.
	LD	DE,MEMFCB	; Internal member FCB to DE.
	PUSH	DE		; Save on stack.
	LD	BC,12		; Move 0filenametyp.
	LDIR			; Do it.
	POP	DE		; Get back member FCB start.
	CALL	INITFCB		; Initialize for reentrance.
	CALL	EXPAND		; Do wildcards (ref. BFRPTR).
	JR	Z,NOTFND	; No file(s), go home.

MEMBLP:	PUSH	DE		; Save member FCB pointer.
	LD	HL,(BFRPTR)	; Get pointer to WILDEX entry.
	LD	BC,16		; Move into member FCB
	LDIR
	LD	(BFRPTR),HL	; Poke in new BFRPTR value.
	LD	A,(RAMTOP)	; Get end of free RAM.
	LD	(RAMDMA+1),A	; Store as buffer ptr. page.
	POP	DE		; Get back FCB.
	LD	HL,10		; Offset to $SYS attribute byte.
	ADD	HL,DE		; Add it in, DE preserved.
	LD	A,(HL)		; Character in A.
	OR	A		; Test for high bit set.
	JP	M,SYSSKP	; Skip the file if it's set.
	LD	(CRUFLG),A	; Leave as a flag for DATER.
	PUSH	DE		; Save FCB again.
	INC	DE		; Point to 11 byte filenametyp.
	LD	HL,LBRFCB+1	; Same in LBR's FCB.
	LD	B,11		; Set counter for length.
EATLP:	LD	A,(DE)		; Get character.
	AND	7FH		; Strip "attribit".
	CP	(HL)		; Compare.
	JR	NZ,NOTEAT	; Any mismatch is A.O.K.
	INC	DE		; Bump both pointers.
	INC	HL
	DJNZ	EATLP		; Loop through all.
	POP	DE		; Balance the stack.
SYSSKP:	LD	DE,LBRFCB	; Point at LBR's FCB.
	JP	SKIPIT		; Share code and loop.

NOTEAT:	POP	DE		; Not a self-eat, proceed.
	CALL	INITFCB		; Initialize.
	CALL	F$OPEN
	JR	NZ,NOTFND	; Should NEVER happen...
	CALL	GETFS		; How big is YOUR member?
	JR	Z,OKMEMB	; Barf if not found, etc.

NOTFND:	LD	BC,(MEMDU)
	CALL	EPRINT
	DB	CR,LF,'Input file ',0
NFOUND:	CALL	PRNDU
	INC	DE
	CALL	PFN2
	CALL	EPRINT
	DB	BEL,' not found.',0
	LD	A,(MEMDIR+1)
	OR	A
	JP	Z,ERRJP
	LD	A,254
	CALL	PUTER2
	LD	BC,(LBRDU)
	CALL	LOGUD
	LD	DE,LBRFCB
ABRT:	CALL	EPRINT
	DB	CR,LF,'Aborting, saving what we have...',0
	JP	DODIR

OKMEMB:	LD	(MEMSIZ),HL	; Store filesize in model.
	CALL	DATER		; DRI-format date to storage
	LD	DE,(MEMSIZ)	; Filesize into DE.
	LD	HL,(BFRPTR)	; Get current WILDEX pointer.
	DEC	HL		; Back up to prev. file's size.
	LD	(HL),D		; Load MSB.
	DEC	HL		; Back up one more.
	LD	(HL),E		; Load LSB.
	LD	HL,MEMFCB	; HL points to member FCB
	LD	DE,MEMDIR	; DE to model LBR dir. entry.
	LD	B,12		; Move 0filenametyp.
MVSTRL:	LD	A,(HL)
	AND	7FH		; The famous attribit strip.
	LD	(DE),A
	INC	HL
	INC	DE
	DJNZ	MVSTRL
	LD	BC,(LBRDU)
	CALL	LOGUD		; We log into LBR's DU
	LD	DE,LBRFCB	; and point at its FCB.

FILEOK:	LD	HL,0		; Read 1st record into TBUFF.
	CALL	R$READ
	JP	NZ,ERROR
	LD	HL,TBUFF	; Set pointer for format check.
	LD	A,(HL)		; Get status byte of directory
	OR	A		; Entry into A, test for zero.
	JP	NZ,FORMER	; Abort if not zero.
	LD	B,11		; Set down-counter for 11 spaces.

CHKDR1:	INC	HL		; Beginning of FCB-style filename
	LD	A,(HL)		; Get byte
	CP	20H		; Must be a space.
	JP	NZ,FORMER	; Abort if not
	DJNZ	CHKDR1		; Loop through all.
	INC	HL		; Bump to index position.
	XOR	A		; Both bytes must be zero.
	CP	(HL)
	JP	NZ,FORMER
	INC	HL
	CP	(HL)
	JP	NZ,FORMER
	INC	HL		; Bump to length
	LD	A,(HL)		; Get LSB in A.
	INC	HL		; Bump to length MSB.
	LD	H,(HL)		; Get length in H.
	OR	H		; Can't be double-precision 0.
	JP	Z,FORMER
	LD	L,A		; Length LSB to L
	PUSH	HL		; Save as a 16-bit down-counter.
	LD	HL,TBUFF+32	; Ignore directory member for
	JR	SECRD		; the first loop

CHKSEC:	PUSH	HL		; Save as a 16-bit down-counter.
	LD	HL,TBUFF	; Point at first status byte.

SECRD:	CALL	CHKMCH		; Check for matching filename.
	JP	Z,FOUND		; Use it if found.
	CALL	CHKDEL		; Check for usable deleted entry.
	JP	Z,FOUND		; That's the second choice.
	CALL	CHKOPN		; Otherwise use first free spot.
	JP	Z,FOUND		; That'll do in a pinch.

NXSTAT:
	LD	DE,32		; Offset to next entry.
	ADD	HL,DE		; Point at next entry.
	LD	B,H		; When H has a 1 we're done.
	DJNZ	SECRD		; Keep going until all 4 are read
	POP	HL		; Otherwise get back 16-bit counter
	DEC	HL		; Subtract one and
	LD	A,L		; Do a test
	OR	H		; For zero.
	JR	Z,NOROOM	; If zero, there's no room here.
	LD	DE,LBRFCB	; Otherwise read in another record
	CALL	NRREAD		; from the library directory.
	JR	Z,CHKSEC	; And loop if no BDOS error.
	JP	ERROR		; BDOS errors land here.

NOROOM:	CALL	EPRINT
	DB	CR,LF,'No more room left in ',0
	LD	BC,(LBRDU)
	CALL	PRNDU
	LD	DE,LBRFCB+1
	CALL	PFN2
	CALL	EPRINT
	DB	',',CR,LF,'reorganize it or create a new LBR file.',0
	DEC	DE		; Point to LBR's FCB.
	LD	A,253
	CALL	PUTER2		; Report error to ZCPR3 flag.
	JP	DODIR		; Assure correct directory CRC.

FORMER:	CALL	CRLF		; Feed CRT a line.
	LD	BC,(LBRDU)	; Retrieve LBR's D/U.
	CALL	PRNDU		; Print with a colon.
	LD	DE,LBRFCB+1	; Point at filenametyp.
	CALL	PFN2		; Print with a period.
	CALL	EPRINT
	DB	' is not a valid LBR file,'
ABTMSG:	DB	BEL,CR,LF,'not supported, aborting.',0
	JP	ERRJP

FOUND:	POP	AF		; Balance the stack harmlessly.
	CALL	EPRINT
	DB	CR,LF,'Putting file ',0
	LD	BC,(MEMDU)	; Get member's directory.
	CALL	LOGUD		; Log in.
	CALL	PRNDU		; Print DU:.
	LD	DE,MEMFCB+1	; Point at FCB+1.
	CALL	PFN2		; Print file's full name.
	LD	HL,(MMDATE)
	LD	A,L
	OR	H
	LD	HL,DATSTR
	CALL	NZ,EPSTR
	CALL	EPRINT
	DB	' in library,',0
	LD	HL,(MEMSIZ)	; Test for zero-length file.
	LD	A,L
	OR	H
	JR	Z,ZEROLN	; We can skip lots of code if Z.
	PUSH	HL		; Otherwise HL needed on stack.
	DEC	DE		; Now point at FCB.
	CALL	CRC3CLR		; Clear the CRC accumulator.
	LD	HL,(MEMIDX)	; Destination record # in LBR.

WRLOOP:
	CALL	FBREAD		; Buffered read, input file.
	OR	A
	JP	NZ,ERROR
	CALL	CCRC		; Update CRC for all of TBUFF.
	LD	BC,(LBRDU)	; Get LBR's DU.
	CALL	LOGUD		; Log in.
	LD	DE,LBRFCB	; Point at FCB
	CALL	R$WRITE		; "Random" write, output file.
	JP	NZ,ERROR
	INC	HL		; Bump record number.
	POP	BC		; Get back member length.
	DEC	BC		; Subtract one.
	LD	A,C		; Check for zero.
	OR	B
	JR	Z,ZEROLN1	; Done if zero.
	PUSH	BC		; Otherwise save it on stack.
	LD	BC,(MEMDU)	; Get member's DU.
	CALL	LOGUD		; Log in.
	LD	DE,MEMFCB	; Point at FCB.
	JR	WRLOOP		; And loop.

ZEROLN1:
	CALL	CRC3DONE	; Finalize CRC if required.
ZEROLN:
	LD	(MEMCRC),HL	; Store CRC or 0000h in MEMDIR

	LD	BC,(LBRDU)	; Get LBR's DU.
	CALL	LOGUD		; (Sigh..) log in.
	LD	DE,LBRFCB	; Point at FCB
	LD	HL,(MEMREC)	; Get record # w/spot for entry.
	CALL	R$READ		; "Random" read.
	JP	NZ,ERROR
	PUSH	DE		; LBRFCB
	PUSH	HL		; (MEMREC)
	LD	DE,(MEMPOS)	; Point DE at member location.
	LD	HL,MEMDIR	; Point to model
	LD	BC,22		; Move 0filenametyp.
	LDIR			; Move 'em out.

	POP	HL		; Select proper record #.
	POP	DE		; Get FCB again.
	CALL	R$WRITE		; "Random" write.
	JP	NZ,ERROR

SKIPIT:	CALL	BIST
	JR	Z,NOABRT
	CALL	BIN
	CP	3
	JP	Z,ABRT
NOABRT:	LD	HL,(COUNT)	; Get WILDEX file count.
	DEC	HL		; Subtract one.
	LD	A,L		; Check if this is last one.
	OR	H
	LD	(COUNT),HL	; Always store updated count.
	JR	NZ,DOLOOP	; More files left, branch ahead.
	LD	HL,(CMDLIN)	; Otherwise get token pointer.
	LD	A,(HL)		; Are we at the null?
	OR	A
	JR	Z,DODIR		; Then we're done.
	CALL	SKSP
	LD	A,','		; Test for comma and
	CPI			; bump pointer.
	JR	NZ,DODIR	; No comma, we're done.
	CALL	SKSP		; Skip stray spaces & tabs.
	LD	A,(HL)
	OR	A		; Clear carry, test for zero.
	JR	Z,DODIR
	PUSH	HL		; Store new pointer on stack.
	LD	BC,(CMDEND)	; Get string's end.
	SBC	HL,BC		; Subtract used as compare.
	POP	HL		; Token pointer back in HL.
	JR	NC,DODIR	; Past end of string?
	LD	A,(NEWLBR)	; New LBR mean no CLEAN needed.
	INC	A
	JR	NZ,OLDLBR	; Branch ahead, already "old".
	LD	(NEWLBR),A	; If here, we are now an "old"
	JR	NXTOK1		; LBR for subsequent runs.
OLDLBR:	LD	(CMDLIN),HL	; Store pointer for parsing.
	LD	DE,LBRFCB	; Need LBR directory again.
	LD	HL,0		; First record.
	CALL	R$READ
	JP	NZ,ERROR
	LD	HL,TBUFF+14	; Read out directory length.
	LD	C,(HL)
	INC	HL
	LD	B,(HL)		; In BC as 16-bit down-counter.
	LD	HL,0
	LD	A,(RAMTOP)	; Get end of free RAM.
	LD	(RAMDMA+1),A	; Store as buffer ptr. page.
TKNCLP:	CALL	CLEAN		; Purge dupes.
	DEC	BC		; Decrement count.
	LD	A,C
	OR	B
	JR	Z,NXTOKE	; Branch to parser w/A=0.
	INC	HL		; Otherwise bump record count.
	LD	DE,LBRFCB	; Point to FCB
	CALL	RBREAD		; Read record into TBUFF.
	JR	Z,TKNCLP	; Loop if no BDOS error.
	JP	ERROR		; BDOS failures wind up here.

NXTOKE:	LD	HL,(CMDLIN)	; Get back command line pointer.
NXTOK1:	LD	DE,FCB2		; Use second default FCB.
	CALL	GETUD		; Reassert home DU.
	CALL	ZPARSE		; Do ZCPR3 parse of one token.
	LD	(CMDLIN),HL	; Store new pointer.
	JP	RENTER		; Do the big loop back.

DOLOOP:	LD	BC,(MEMDU)	; Get input DU.
	CALL	LOGUD		; Log in.
	LD	DE,MEMFCB	; Point at member FCB.
	JP	MEMBLP		; Do a big loop back.

DODIR:	LD	HL,0
	CALL	R$READ		; Read first record into buffer.
	JP	NZ,ERROR
	LD	HL,TBUFF	; Point to TBUFF.
	CPI			; Compare to 0 in A, bump HL.
	JP	NZ,FORMER	; Gotta match or it's NG.
	LD	A,' '		; We need a blank filenametyp.
	EX	DE,HL
	CALL	CHARCK
	JP	NZ,FORMER	; Must match or we gots a botch.

OKLBR:	LD	HL,TBUFF+14	; Point at directory size
	LD	C,(HL)		; Directory size to BC
	INC	HL
	LD	B,(HL)
	INC	HL		; Bump to CRC
	XOR	A		; Zero out A (saves a byte)
	LD	E,(HL)		; Read out LSB to E
	LD	(HL),A		; Replace with a zero
	INC	HL		; Bump to MSB
	LD	D,(HL)		; Read out to D
	LD	(HL),A		; Replace with a zero
	PUSH	DE		; Save on stack
	CALL	CRC3CLR		; Clear out CRC accumulator
	LD	HL,0		; Prepare HL for RBREAD call.
	LD	A,(RAMTOP)	; Get end of free RAM.
	LD	(RAMDMA+1),A	; Store as buffer ptr. page.

CRCDIR:	LD	A,(NEWLBR)
	INC	A
	JR	Z,SKPCLN	; New LBRs don't need CLEANing.
	LD	A,(FCB2+1)	; Was this format/CRC-only run?
	CP	20H+1		; If it wasn't, then we
	CALL	NC,CLEAN	; check for duplicate filenames.
SKPCLN:	CALL	CCRC		; Do CRC on (altered?) record.
	DEC	BC		; Is this the last one?
	LD	A,C
	OR	B
	JR	Z,DIRDON	; If so, that's that.
	INC	HL		; Otherwise bump record number.
	LD	DE,LBRFCB	; Point to FCB again.
	CALL	RBREAD		; Read record into TBUFF.
	JR	Z,CRCDIR	; And loop if no BDOS error.
	JR	ERROR		; BDOS errors land here.

DIRDON:	CALL	CRC3DONE	; Finalize CRC calculation.
	POP	DE		; Get back original CRC.
	CALL	COMPHD		; Non-destructive compare HL/DE.
	LD	DE,LBRFCB	; Point to (yawn) FCB.
	JR	Z,SGNOFF	; If identical, write nothing.
	LD	B,H		; Otherwise, save HL to BC.
	LD	C,L
	LD	HL,0		; Select first record
	CALL	R$READ		; "Random" read.
	JR	NZ,ERROR	; Trap BDOS errors.
	LD	(TBUFF+16),BC	; Poke in value.
	CALL	R$WRITE		; Write back record.
	JR	NZ,ERROR

SGNOFF:	CALL	F$CLOSE		; Close up shop for keeps.
	OR	A		; Make sure we got a 0.
	JR	NZ,ERROR
	INC	DE		; Point at filenameLBR.
	LD	BC,(LBRDU)	; Retrieve LBR's DU.
	CALL	CRLF
	CALL	PRNDU		; Print with colon.
	CALL	PFN2		; Print filename.LBR.
	CALL	EPRINT
	DB	' closed, operation complete.',0
	JR	DIROK

ERROR:	CALL	EPRINT
	DB	BEL,CR,LF,'BDOS file access error, aborting.',0
ERRJP:	XOR	A
	DEC	A
	CALL	PUTER2

DIROK:	CALL	GETUD		; Not really needed, but W.T.H.
	LD	SP,(STACK)
	RET


; SUBROUTINES FOLLOW:

;
; Service routine for S. Kluger's WILDEX and MYSORT (SORT) modules
;
EXPAND:
	PUSH	DE
	LD	HL,(CRCTBL)	; Use boundary above CRC table.
	INC	H
	INC	H		; By exactly 512 bytes.
	LD	(BFRPTR),HL	; Store that address.
	LD	(CLNPTR),HL	; Again for CLEAN.
	CALL	WILDEX		; Expand FCB at (DE) to (HL).
	JR	Z,NOWILD
	LD	(COUNT),HL	; Save count of files.
	LD	(CCOUNT),HL	; Again for CLEAN.
	LD	BC,16		; 16 bytes per WILDEX entry.
	EX	DE,HL		; Count to DE.
	LD	HL,(BFRPTR)	; WILDEX listing start in HL.
PTRLP:	ADD	HL,BC		; Add 16 bytes for each entry.
	DEC	DE		; Decrement count.
	LD	A,E		; Test for zero.
	OR	D
	JR	NZ,PTRLP
	OR	L		; Coincidental boundary?
	JR	Z,PUTBOT	; Otherwise find next one.
	INC	H		; Next page.
	LD	L,D		; L = D = 0: even boundary.
PUTBOT:	LD	(RAMBOT),HL	; Save as bottom of file buffer.
	LD	BC,(COUNT)	; Set up for sort.
	LD	A,C
	DEC	A
	OR	B		; Only one file in list?
	JR	Z,NOSORT	; No need to sort then...
	LD	DE,16		; Length per entry.
	LD	HL,(BFRPTR)
	CALL	SORT		; Sort WILDEX list.
	XOR	A
NOSORT:	DEC	A		; Assure NZ on return.
NOWILD:	POP	DE
	RET			; And return to caller.

; Buffered file reader, acts like F$READ (for ONE file!)

FBREAD:	PUSH	HL
	PUSH	DE
	PUSH	BC
	LD	A,(RAMTOP)
	LD	HL,(RAMDMA)
	SUB	H
	JR	NZ,NOFILL
	CALL	FILRAM
	JR	Z,NOFILL
	DEC	A
	JR	NZ,FILERT
NOFILL:	LD	DE,TBUFF
	LD	B,D
	LD	C,E
	LDIR
	LD	(RAMDMA),HL
	XOR	A
FILERT:	POP	BC
	POP	DE
	POP	HL
	RET

FILRAM:	LD	HL,(RAMBOT)
	LD	(RAMDMA),HL
	LD	BC,80H
FILLLP:	CALL	SETDMA
	CALL	F$READ
	JR	NZ,FILERR
	ADD	HL,BC
	LD	A,(RAMTOP)
	SUB	H
	JR	NZ,FILLLP
FILERR:	LD	H,B
	LD	L,C
	CALL	SETDMA
	LD	HL,(RAMDMA)
	RET


; Buffered file reader, acts like R$READ (for ONE file!)
; An initializing R$READ call is required before using!

RBREAD:	PUSH	DE
	PUSH	BC
	PUSH	HL
	LD	A,(RAMTOP)
	LD	HL,(RAMDMA)
	SUB	H
	JR	NZ,NORILL
	CALL	RILRAM
	JR	Z,NORILL
	DEC	A
	JR	Z,NORILL
	SUB	3
	JR	NZ,RILERT
NORILL:	LD	DE,TBUFF
	LD	B,D
	LD	C,E
	LDIR
	LD	(RAMDMA),HL
	XOR	A
RILERT:	POP	HL
	POP	BC
	POP	DE
	RET

RILRAM:	LD	HL,(RAMBOT)
	LD	(RAMDMA),HL
	LD	BC,80H
RILLLP:	CALL	SETDMA
	CALL	NRREAD
	OR	A
	JR	NZ,RILERR
	ADD	HL,BC
	LD	A,(RAMTOP)
	SUB	H
	JR	NZ,RILLLP
RILERR:	LD	H,B
	LD	L,C
	CALL	SETDMA
	LD	HL,(RAMDMA)
	RET


; Read "next" random record to current DMA buffer, DE points to FCB.

NRREAD:
	PUSH	HL
	PUSH	BC
	LD	HL,21H		; Offset AND function # too(!).
	LD	C,L		; Into C for BDOS call.
	ADD	HL,DE		; Add in offset.
	INC	(HL)		; Pseudo 16-bit increment...
	INC	HL
	JR	NZ,JLSB
	INC	(HL)
JLSB:	INC	HL
	LD	(HL),0		; Got this from R$READ.
	CALL	BDOS		; SYSLIB preserves DE for us.
	OR	A		; <>0 is a BDOS error.
	POP	BC
	POP	HL
	RET


; Print "DU:" to CON: when B=Disk and C=User code.
;	(COUT is public label for SYSLIB)

PRNDU:	LD	A,B
	ADD	A,'A'
	CALL	BOUT
	LD	A,C
	CALL	PAFDC
	LD	A,':'
COUT:	JP	BOUT		; JP xxxx = CALL xxxx!RET


; Compute CRC for record in TBUFF (adapted from S.Kluger).
;	(Services routine CRC3UPD)
;
CCRC:	PUSH	HL
	LD	HL,TBUFF
CCRC1:	LD	A,(HL)
	CALL	CRC3UPD
	INC	L
	JR	NZ,CCRC1
	POP	HL
	RET

;
; Check FCB-style filenametyp for ambiguity, alternate entry
; point CHARCK permits scanning from any character.
;

AMBCHK:	LD	A,'?'		; For ambiguity
;
CHARCK:	LD	H,D		; Copy DE
	LD	L,E		; To HL
	LD	BC,11		; Check FILENAMETYP
	CPIR			; Z80-style
	RET			; Returns Z if found.

;
; Checks LBR directory entry pointed to by HL for a match with
; the model entry at MEMDIR, compares available space with size
; of proposed replacement.
;
CHKMCH:	PUSH	HL		; Save pointer.
	LD	DE,MEMDIR+1	; Point at search "vector".
	LD	B,11		; Load B with length.
	EX	DE,HL		; Swap registers.
NMLOOP:	INC	DE		; Point at possible match.
	LD	A,(DE)		; Get target character.
	AND	7FH		; Reset "attribit".
	CP	(HL)		; Compare to pointed one.
	JR	NZ,NOMTCH	; Must be alike.
	INC	HL		; Bump and
	DJNZ	NMLOOP		; `->loop.
LENCH2:	POP	DE		; Retrieve pointer.
	LD	(MEMPOS),DE	; Store to model.
	PUSH	DE		; Save it again.
	LD	HL,14		; Offset to member length.
	ADD	HL,DE		; Add in offset.
	LD	C,(HL)		; Read out length
	INC	HL
	LD	B,(HL)		; To BC.
	LD	HL,(MEMSIZ)	; Retrieve candidate's size.
	XOR	A		; Reset carry flag.
	SBC	HL,BC		; Subtract used as compare.
	JR	NZ,NOMTCH	; Must be same size or no match.
	LD	HL,12		; Offset to member index.
	ADD	HL,DE		; Add it in.
	LD	C,(HL)		; Read out index
	INC	HL		;
	LD	B,(HL)		; To BC.
	LD	(MEMIDX),BC	; Plug it into model.
LENCHK:	LD	DE,LBRFCB
LENCH3:	CALL	GETRR		; Get current record.
	JP	NZ,ERROR	; Abort on error.
	LD	(MEMREC),HL	; Save that to model.
NOMTCH:	POP	HL		; Return with correct zero flag
	RET			; and original pointer in HL.

;
; Checks LBR directory entry pointed to by HL for deleted status.
; Entry is re-used if length matches candidate's.

CHKDEL:	PUSH	HL		; Save pointer.
	LD	A,0FEH		; LUDEF's "deleted" status byte.
	CP	(HL)		; Compare to pointed value
	JR	NZ,NOMTCH	; Return failed if no match.
	JR	LENCH2		; Share code to check length.

;
; Checks the LBR entry pointed to by HL for an open entry.
; First open entry is used if CHKMCH and CHKDEL keep failing.
;
CHKOPN:	LD	A,(HL)		; Get status byte.
	INC	A		; Test for 0FFH
	RET	NZ		; Return failed if not.
	LD	(MEMPOS),HL	; Otherwise record position.
	PUSH	HL		; Will be popped at NOMTCH.
	CALL	DFREE		; Compute free space in Kbytes.
	LD	B,D		; Stash
	LD	C,E		; in BC.
	LD	HL,(MEMSIZ)	; Get member size into HL.
	LD	DE,8		; Divisor to DE
	CALL	COMPHD
	JR	C,ONEK
	CALL	DIVHD		; Convert record count to K.
	INC	HL		; Bump by one just in case.
	JR	MOREK
ONEK:	LD	HL,1
MOREK:	XOR	A		; Reset carry flag.
	SBC	HL,BC		; Subtract used as compare.
	JR	C,ENUFF		; BC should be larger.

NOENUF:	CALL	EPRINT
	DB	BEL,CR,LF,'Insufficient disk space for ',0
	LD	BC,(MEMDU)
	LD	DE,MEMFCB+1
	CALL	PRNDU
	CALL	PFN2
	LD	A,','
	CALL	BOUT
	POP	HL
	POP	DE
	JP	SYSSKP
;
ENUFF:	LD	DE,(LBREND)	; Get end of LBR file.
	LD	(MEMIDX),DE	; Load to the model.
	LD	HL,(MEMSIZ)	; Get member size into HL.
	ADD	HL,DE		; Update end of LBR.
	LD	(LBREND),HL	; Store it.
	JP	LENCHK		; Share code and return.

;
; Scans for matching filenames with non-matching lengths on exit.
; This "cleans" the LBR directory of duplicate member names.
;
CLEAN:	PUSH	BC		; Save down-counter.
	PUSH	HL		; Save current random record #.
	CALL	REFRSH		; Initialize file list data.
	JR	NZ,GOCLEA	; No files added?  Just return.
	POP	HL
	POP	BC
	RET

GOCLEA:	LD	HL,TBUFF	; Point at first entry
	XOR	A		; Dual-purpose 0 to accumulator.
	LD	(WRTFLG),A	; First reset write flag.

BGLOOP:	CP	(HL)		; Is this not an active entry?
	JR	NZ,LOOPCN	; Not our concern then...
	PUSH	HL		; Save pointer on the stack.
	LD	DE,(BFRPTR)	; Get pointer to buffer entry.
	LD	B,11		; Compare filenametyp, 11 chars.

CLNLOP:	INC	DE		; Line up target "vector".
	INC	HL		; Bump model pointer.
	LD	A,(DE)		; Target in A.
	AND	7FH		; Strip "attribit".
	CP	(HL)		; Compare to model.
	JR	NZ,OKCLN	; Any non-match disqualifies us.
	DJNZ	CLNLOP		; Decrement counter and loop.
	POP	HL		; Get pointer.
	PUSH	HL		; Save it again
	LD	DE,14		; Offset to length of member.
	ADD	HL,DE		; Add in offset (DE preserved).
	LD	C,(HL)		; Read out value to BC.
	INC	HL
	LD	B,(HL)
	LD	HL,(BFRPTR)	; Get pointer to list entry.
	ADD	HL,DE		; Add in offset.
	LD	A,(HL)		; Read out value to HL.
	INC	HL
	LD	H,(HL)
	LD	L,A
	XOR	A		; Reset carry flag.
	SBC	HL,BC		; Subtract used as compare.
	POP	HL		; Regardless, pointer back to HL.
	JR	Z,LOOPCN	; This must be the Real McCoy.
	DEC	(HL)		; Otherwise decrement the status
	DEC	(HL)		; Byte to FEh (deleted).
	LD	A,0FFH		; Write-needed value (non-zero).
	LD	(WRTFLG),A	; Plant it.
	JR	LOOPCN		; Go check for end of record.
;
OKCLN:	POP	HL		; Get back entry pointer
;				(80h, A0h, C0h or E0h allowed)
LOOPCN:	EX	DE,HL		; Pointer to DE.
	LD	HL,(BFRPTR)	; Get list pointer.
	LD	BC,16		; Offset to next entry.
	ADD	HL,BC		; Add it in.
	LD	(BFRPTR),HL	; Update storage.
	EX	DE,HL		; Pointer to back in HL.
	LD	DE,(COUNTC)	; Get count.
	DEC	DE		; Subtract for one entry done.
	LD	A,E		; Test for last one.
	OR	D
	LD	(COUNTC),DE	; Update storage.
	LD	A,0		; Zero to accumulator for loop.
	JR	NZ,BGLOOP	; Loop if not finished.
;
	CALL	REFRSH		; Restore WILDEX list data.
	LD	DE,32		; Offset to next entry.
	ADD	HL,DE		; Add it in.
	LD	B,H		; MSB to B register (1 = done).
	XOR	A		; Zero to accumulator for loop.
	DJNZ	BGLOOP		; Test for a 1, loop if not.
	POP	HL		; Otherwise get back record #
	LD	A,(WRTFLG)	; Get write flag.
	OR	A		; Test for zero (don't write).
	LD	DE,LBRFCB	; Point at FCB for write.
	CALL	NZ,R$WRITE	; Write back record if required.
	JP	NZ,ERROR	; We won't get this jump if Z.
	POP	BC		; Get back the down-counter
	RET			; And return.

REFRSH:	PUSH	HL
	LD	HL,(CCOUNT)	; Get original WILDEX count.
	LD	BC,(COUNT)	; Get leftovers or 0000H.
	XOR	A		; Clear carry flag.
	SBC	HL,BC		; 16-bit subtract.
	LD	(COUNTC),HL	; Refresh our counter.
	LD	HL,(CLNPTR)	; Get virgin buffer start.
	LD	(BFRPTR),HL	; Refresh buffer pointer.
	POP	HL
	RET

; Creates an LU3xx-compatible LBR file with enough room for all
; the requested input files.  If the special input filespec
; "/xx" is encountered, creates an empty LBR with room for "xx"
; member files.

MKNLBR:
	PUSH	DE		; Save incoming DE.
	LD	DE,FCB2+1	; Point member FCB+1.
	LD	A,(DE)		; Character in A.
	SUB	'/'		; Want an empty LBR?
	JR	NZ,NJLBR	; Branch ahead if not.
JLBR:	EX	DE,HL		; Pointer to HL.
	LD	(HL),A		; Plant flag for no member add.
	INC	HL		; Bump to number.
	CALL	EVAL10		; Evaluate ASCII=16-bit binary.
	JR	DOMKNE		; Go build LBR.

NJLBR:	DEC	DE		; Point to FCB start.
	LD	HL,(CMDLIN)	; Make local CMDLIN pointer.
	LD	(MKNCMD),HL
	EX	DE,HL		; Source FCB to HL.
	LD	DE,MKNFCB	; Local FCB in DE.
	PUSH	DE		; Save source.
	LD	BC,16		; Make local copy of FCB.
	LDIR
	POP	DE		; Point to it.
	LD	(MKNCNT),BC	; Init. local file count to 0.
	CALL	GETUD		; Assert home (CPR's) DU:.
MKNLP:	CALL	Z3LOG		; Log in to FCB's DU:.
	CALL	INITFCB		; Initialize.
	LD	HL,(CRCTBL)	; Establish a safe buffer.
	INC	H		; Compute CRC_look-up_table+512.
	INC	H
	CALL	WILDEX		; Expand, Sigi-style.
	JR	Z,NOMKWD	; No files, do next token.
	LD	BC,(MKNCNT)	; Get current count.
	ADD	HL,BC		; Add new ones to it.
	LD	(MKNCNT),HL	; Store.
NOMKWD:	LD	HL,(MKNCMD)	; Get local token pointer.
	CALL	SKSP
	LD	A,','		; Test for comma and
	CPI			; bump pointer.
	JR	NZ,DOMKN	; No comma, we're done.
	CALL	SKSP		; Skip stray spaces & tabs.
	LD	A,(HL)
	OR	A		; Clear carry, test for zero.
	JR	Z,DOMKN
	PUSH	HL		; Store new pointer on stack.
	LD	BC,(CMDEND)	; Get string's end.
	SBC	HL,BC		; Subtract used as compare.
	POP	HL		; Token pointer back in HL.
	JR	NC,DOMKN	; Past end of string?
	CALL	GETUD		; Assert home (CPR's) DU:.
	XOR	A		; DIR: before DU:.
	CALL	ZPARSE		; Z3 parse into local FCB.
	LD	(MKNCMD),HL	; Store new local token pointer.
	JR	MKNLP		; Loop around.
DOMKN:	LD	DE,(MKNCNT)	; Get final count.
	LD	A,E		; Can't have zero members either.
DOMKNE:	OR	D		; So check for that.
	JP	Z,EREXIT	; Go home if zero members asked.
	LD	BC,(LBRDU)	; Log in now, avoid rush later.
	CALL	LOGUD
	INC	DE		; Bump count for LBR directory.
	LD	HL,(EXTRA)	; Get any requested extras
	ADD	HL,DE		; Add 'em in to get total in HL
	PUSH	HL		; Save it on stack.
	LD	DE,4		; Divisor to DE.
	CALL	DIVHD		; SYSLIB's HL/DE.
	LD	D,H		; Result copied to DE.
	LD	E,L
	ADD	HL,HL		; Multiply x2
	ADD	HL,HL		; & x4
	POP	BC		; Get back original member count.
	XOR	A		; Clear carry, A = 0.
	SBC	HL,BC		; See if it was larger.
	JR	NC,PLUGIN	; Bump record count by one if so.
	INC	DE
PLUGIN:
	LD	HL,ENTRY1	; Init. model in DSEG.
	LD	(HL),A		; Set 1st byte to 0
	PUSH	HL		; Save address
	LD	B,11		; Prepare to space fill next 11 bytes
SPCLP:	INC	HL
	LD	(HL),20H
	DJNZ	SPCLP

	LD	B,ENDMDL-ENTRY1-12
ZERLP:				; Prepare to 0 fill rest of model
	INC	HL
	LD	(HL),A
	DJNZ	ZERLP
	LD	(STORE),DE	; Store length to the model.
	LD	DE,TBUFF	; Point at our disk buffer.
	POP	HL		; Point at beginning of model.
MDLLOO:				; Build first record of LBR.
	PUSH	HL		; Save that model pointer.
	LD	BC,ENDMDL-ENTRY1
	LDIR			; Move out model.
	POP	HL		; Get back pointer.
	LD	(HL),0FFH	; Store "open" status flag.
	LD	(STORE),BC	; Store 0000H to length.
	LD	B,D		; If we're done, D = 1.
	DJNZ	MDLLOO		; Test and loop if it's not.

	LD	DE,LBRFCB
	CALL	F$MAKE
	INC	A
	JP	Z,ERROR
	CALL	F$WRITE		; And write record #1 to disk.
	JP	NZ,ERROR
	LD	HL,TBUFF+14	; If here, A = 0, point length.
	LD	C,(HL)		; Read out & replace with zeros.
	LD	(HL),A
	INC	HL
	LD	B,(HL)
	LD	(HL),A
	DEC	A		; A = 0FFh.
	LD	(TBUFF),A	; Store "open" status flag.
	LD	H,B		; Copy BC to HL.
	LD	L,C
	ADD	HL,HL		; Compute LBR capacity.
	ADD	HL,HL
	DEC	HL		; This HL will survive all else.
FFLOOP:
	DEC	BC		; Decrement record count by one.
	LD	A,C
	OR	B		; Test for zero.
	JR	Z,FINIS		; Break loop if so.
	CALL	F$WRITE		; Write record, BC, DE & HL ok.
	JR	Z,FFLOOP	; Loop if no BDOS error.
	JP	ERROR

FINIS:	CALL	F$CLOSE		; Close up for now.
	OR	A
	JP	NZ,ERROR
	LD	A,(FCB2+1)	; Are we gonna add members?
	OR	A
	JR	NZ,EREXIT	; We're done if so.
	DEC	A		; Otherwise assure return w/NZ.
	CALL	EPRINT		; Tell 'em how much room in LBR.
	DB	' for ',0
	CALL	PHLFDC
	CALL	EPRINT
	DB	' members.',0
EREXIT:	POP	DE		; Restore incoming DE & go home.
	RET

; Use the best Z3 parser we can find...

ZPARSE:	CALL	Z33CHK
	JP	Z,Z33FNAME
	XOR	A
	JP	ZFNAME

; Dating routine, calls DSLIB and Sigi's UNDATE (@UDCVT)

DATER:	CALL	TIMINI		; Find The DateStamper
	JR	Z,GFAIL
	PUSH	DE
	LD	HL,USRDAT	; Our local BCD storage
	CALL	RCLOCK		; Make current date the fallback
	LD	HL,MYEAR	; Fill in mod date also
	CALL	Z,RCLOCK
	POP	DE		; Get back FCB pointer
	JR	NZ,GFAIL	; Trap TIMINI and RCLOCK failures
	LD	A,(CRUFLG)	; Is the file crunched?
	SUB	'Z'		; Zero means possibly crunched.
	JR	Z,ISCRU
	INC	A		; Zero here means possibly LZH encoded
	JR	NZ,NOTCRU	; Otherwise no imbedded BCD date
ISCRU:	CALL	F$READ		; Read a record into TBUFF
	LD	HL,32		; Offset to "next record" in fcb
	ADD	HL,DE
	LD	(HL),0		; Reset next record
	LD	HL,TBUFF	; Set pointer to first byte
	LD	A,(HL)		; Get it
	SUB	76H		; Test for crunched file
	JR	NZ,NOTCRU	; OK, no imbedded BCD if NZ
	INC	HL		; Bump pointer to filename strg.
	INC	HL		; (A = 0 if all's well)
	INC	A		; Look for tell-tale 1
	LD	B,13		; Search range
CRULP1:	CP	(HL)		; Test
	INC	HL		; Bump
	JR	Z,GOTCRU	; OK, we point at BCD date
	JR	NC,NOTCRU	; Hit a null, no imbedded BCD
	DJNZ	CRULP1		; Keep on loopin'
	JR	NOTCRU		; Failed search, no imbedded BCD
GOTCRU:	LD	B,15
	LD	DE,USRDAT	; Otherwise move to our buffer
CRULOO:	LD	A,(HL)		; Testing for Bridger's
	INC	A		; zero-surrogates all the while
	JR	Z,FFTO0		; If it's a zero, so be it
	DEC	A		; Otherwise restore it
FFTO0:	LD	(DE),A
	INC	DE
	INC	HL
	DJNZ	CRULOO
	JR	DONDAT		; Go do conversion stuff

NOTCRU:	LD	HL,USRDAT	; Our buffer pointer in HL
	CALL	GSTAMP		; Get DS dossier into buffer
	LD	A,(DOSTYP)
	CP	'3'		; Check for CP/M 3
	CALL	Z,INITFCB	; Freshen fcb and reopen if so
	CALL	Z,F$OPEN	; GSTAMP messes up fcb under CP/M 3
	LD	A,(MONTH)	; Month in range?
	CP	12H+1		; No month <12
	JR	NC,NOMNTH
	OR	A		; No month #0 either
	JR	NZ,DONDAT	; Non-zero is accepted now
NOMNTH:	LD	HL,USRDAT
	CALL	RCLOCK
	LD	HL,MYEAR	; Fill in mod date also
	CALL	Z,RCLOCK
	JR	Z,DONDAT
GFAIL:	LD	HL,0		; When no dates available
	LD	(MCDATE),HL	; Clean out both fields
	JR	GFAIL1		; On our way out

DONDAT:	CALL	DONDAT1		; Convert DS data to ASCII
	LD	(MCDATE),HL	; ..and ret with 16 bit cre date
	LD	HL,MYEAR	; Point to last mod stats
	LD	DE,YEAR		; Point to where @UDCVT will look
	LDI			; Move year
	LDI			;      month
	LDI			;      day
	CALL	DONDAT1		; Conver mod date to 16 bits
GFAIL1:	LD	(MMDATE),HL	; Store mod date for later
	LD	HL,TBUFF	; DSLIB munges DMA,
	JP	SETDMA		; so restore DMA and return

DONDAT1:
	LD	A,(MONTH)	; Get BCD month
	LD	HL,@DCFLD-1	; Point byte before ASCII strg.
	CALL	STOREA		; Store as ASCII in string
	LD	A,(DAY)		; Get BCD day
	CALL	STOREA		; Store as ASCII in string
	LD	A,(YEAR)	; Get BCD year
	CALL	STOREA		; Store as ASCII in string
	CALL	@UDCVT		; Convert to DRI in HL
	RET	NC		; Carry set is format error
	LD	HL,0		; Null date on failure
	RET

;	Store ASCII

STOREA:	LD	B,A		; Stash BCD in B
	RRCA			; Exchange nybbles
	RRCA
	RRCA
	RRCA
	CALL	MASK
	DEC	HL
	LD	A,B		; Get other nybble
;	fall	through
MASK:	AND	0FH		; Mask
	ADD	A,'0'		; ASCII
	INC	HL		; Bump pointer
	LD	(HL),A		; Store
	INC	HL
	RET

DATSTR:	DB	' ('
@DCFLD:	DB	'00/00/00)',0

$MEMRY:	DS	2		; Must be in CSEG or it's lost.


	DSEG

ENTRY1:	DS	14		; Model LBR directory member
STORE:	DS	2		; Save 16-bit record count here.
	DS	16
ENDMDL:	DS	0

MKNFCB:	DS	36		; Working FCB for MKNLBR.
MKNCNT:	DS	2		; Local filecount for MKNLBR.
MKNCMD:	DS	2		; Local CMDLIN pointer for ^.

NEWLBR:	DS	1		; 0FFh if we know LBR is clean.

WRTFLG:	DS	1		; 0FFh if CLEAN must write.

LBREND:	DS	2		; Holds end record # of LBR.

LBRDU:	DS	2		; Holds LBR user code and drive.
LBRFCB:	DS	36

MEMDU:	DS	2		; Same thing for the member file.
MEMFCB:	DS	36

MEMREC:	DS	2		; Record # of LBR dir entry.
MEMPOS:	DS	2		; Entry's start in TBUFF.

MEMDIR:	DS	12		; Member 0filenametype.
MEMIDX:	DS	2		; Member index in LBR.
MEMSIZ:	DS	2		; Member's lusty length.
MEMCRC:	DS	2		; Member's CRC.
MCDATE: DS	2		; Creation date.
MMDATE: DS	2		; Last modification date.

BFRPTR:	DS	2		; Pointer to expanded wildcards.
COUNT:	DS	2		; Number of files in expansion.

CLNPTR:	DS	2		; Duplicates for CLEAN routine.
CCOUNT:	DS	2
COUNTC:	DS	2

CMDLIN:	DS	2		; Pointer to current cmd. token.
CMDEND:	DS	2		; End of stored command line.

CRCTBL	DS	2		; Pointer to CRC table
RAMDMA:	DS	2		; Current pointer, input buffer.
RAMBOT:	DS	2		; Start of input buffer.
RAMTOP:	DS	1		; Last page of free RAM.

CRUFLG:	DS	1
EXTRA:	DS	2

STACK:	DS	2		; The CPR stack pointer storage.

USRDAT:
YEAR:	DS	1		; Creation date
MONTH:	DS	1
DAY:	DS	3		; Creation day, hour, minute
	DS	5		; Last Access date and time
MYEAR:	DS	6		; Last Mod date and time

	END