;***********************************************************************
;*								       *
;*			     UNCRunch v2.4			       *
;*			      15 Sept 1987			       *
;*						- Steven Greenberg     *
;*								       *
;***********************************************************************

	.Z80
	.SALL
	TITLE 'UNCRrunch v2.4  15 Sept 1987'

	EXTRN	UNCR1,PARSEU,USQREL
	ENTRY	GETBYT,OUT

	CSEG
;
;=======================================================================
;
MEMPAG	EQU	1C00H		; <=== set! [see comment near end of program]
;
;=======================================================================
;
;.......................................................................
;
; v2.4	Update Note:  As explained in the CRUNCH24 general release .LBR,
; v2.4 will generate identical	files  (except	embedded  revision level
; byte) to  CRUNCH v2.3.  The great  majority of  the  changes	are user
; interface related,  and are described  in the  CRUNCH24  documentation
; files.  Some changes were made  in the implementation of the "core" of
; the algorithms  for both CRUNCH and UNCRunch - in the case  of CRUNCH,
; conditionals were removed by	splitting into three separate loops.  In
; the case  of UNCRunch, an  unnecessary  chase to  the  end  of"virtual
; links" was eliminated by aborting  the search as soon as  an available
; reassignments lot  is found.	Other performance  improving changes in-
; clude less  time updating  the screen and  dynamic I/O  buffer sizing.
; Non-time-critical  "user-interface" changes (eg. the "tag  mode" code,
; etc.)  were  coded in as straightforward  a manner  as  possible, with
; little regard to code space minimization and even less to speed.
;
; While some documentation  of the code  has been cleaned up in the sev-
; eral month interim between the CRUNCH24.LBR release and the release of
; this source code, I have been very careful to  avoid any temptation to
; change any of the code itself, thus insuring that this source code can
; be used to create the identical COM files included in the v2.4 release
; of CRUNCH.
;
;.......................................................................
;
NO	EQU	0
YES	EQU	NOT NO
CRUNCH	EQU	NO		; Yes for CRUNCH, no for UNCR (for common)

REV	EQU	24H		; Program revision level
SIGREV	EQU	20H		; "Significant" revision level (compatibility)

NOPRED	EQU	0FFFFH		; "No predecessor"
IMPRED	EQU	07FFFH		; Pred that can't be matched or bumped

SCRUPT1	EQU	01H		; Screen update speeds
SCRUPT2	EQU	07H
;
; --- Reserved codes ---
;
EOFCOD	EQU	100H		; EOF code
RSTCOD	EQU	101H		; Adaptive reset code
NULCOD	EQU	102H		; Null code
SPRCOD	EQU	103H		; Spare code
;
; --- ASCII equates ---
;
CTRLC	EQU	03H		; ^c
BELL	EQU	07H		; Beep
BS	EQU	08H		; Backspace
LF	EQU	0AH		; Linefeed
CR	EQU	0DH		; Carriage return
;
; --- CP/M address equates ---
;
DFCB	EQU	5CH		; Default FCB #1
DFCB2	EQU	6CH		; Default FCB #2
DDMA	EQU	80H		; Default DMA address
BDOS	EQU	0005H		; BDOS entry point
;
; --- BDOS function equates ---
;
CONIN	EQU	1		; Input a character from the console
CONOUT	EQU	2		; Output single char to console
PRTSTR	EQU	9		; Print string to console
CONST	EQU	11		; Get console status
GETVER	EQU	12		; Get CP/M version#
SELDSK	EQU	14		; Select disk
OPEN	EQU	15		; Open file
CLOSE	EQU	16		; Close file
SFIRST	EQU	17		; Search for first file
SNEXT	EQU	18		; Search for next file
ERASE	EQU	19		; Erase file
READ	EQU	20		; Read file (sequential)
WRITE	EQU	21		; Write file (sequential)
MAKE	EQU	22		; Make file
GETDSK	EQU	25		; Get currently logged drive
SETDMA	EQU	26		; Set DMA address
GSUSER	EQU	32		; Get/set user code
RSTDRV	EQU	37		; Reset drive
SETMS	EQU	44		; Set multi-sector count (cp/m+ only)
;
;_______________________________________________________________________
;
; Macros to facilitate "horizontal" movement through the table.
; See "Table structure" comment near "initbl" for more information.
;
RIGHT1	 MACRO
	LD	A,H		; }
	ADD	A,10H		; } move "right" one column (same row)
	LD	H,A		; }
	 ENDM
;
;=======================================================================
;
START:	JP	STRT		; <--- entry
;
;=======================================================================
;
	DB	'Z3ENV',01H	; ZCPR3 environment descriptor

Z3ED:	DB	00H,00H
;
;-----------------------------------------------------------------------
;
Z3FLG:	DB	0		; ZCPR flag
SPFLG:	DB	0		; Spare flag (archive mode for crunch)
INSREV:	DB	23H		; Program rev for install program reference
QUIFL:	DB	0		; Quiet mode flag
NPROFL:	DB	0		; No prompt before overwrite flag
TRBOFL:	DB	0		; Defeat multi-sector i/o flag
CNFRFL:	DB	0		; Confirm every file flag
WRMFLG:	DB	0		; Warm boot flag
BIGFLG:	DB	0		; Override larger file question flag
MAXDRV:	DB	0FFH		; Max drive
MAXUSR:	DB	0FFH		; Max user
SPARFL:	DB	0		; Spare flag or value

EXTBL:	DB	0,0,0,0,0,0	; Room for the "exclusion list". used in
	DB	0,0,0,0,0,0	; - CRUNCH, but want compatible overlays.
	DB	0,0,0,0,0,0	; (enough for 10 3-letter filname extensions)
	DB	0,0,0,0,0,0
	DB	0,0,0,0,0,0
;
;=*=-=*=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=
;
CPYRT:	DB	CR,LF,LF
	DB	'UNCR  v2.4   Copyright (c)   S. Greenberg  09/15/87'
	DB	CR,LF
	DB	'May be reproduced for non-profit use only','$'
	DB	' 201-670-8724'
;
;=*=-=*=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=
;
STRT:	SUB	A		; Z-80 test [RAF]
	JP	PO,Z80
	LD	DE,WRNGUP	; "Program requires z-80 processor"
	JP	MESS80		; No frills exit w/ message

Z80:	LD	(OLDSTK),SP	; Save os's stack
	LD	SP,TOPSTK	; Set local stack

	CALL	STRTUP		; Does a lot of stuff
;
;=======================================================================
;
;	*****	Re-enter here for each matching file *****
;
; General wildcard operation:  When the program is first invoked, a ll
; matching filenames are put end to end in FNBUFF, 12 bytes each, in
; alalphabetical order.  Since a filename is only 11 characters long,
; the spare byte, which precedes each filename, is used as a "tag/flag".
; By the time file processing starts (now), a number of routines have
; already run (parts  of the STRTUP routine).  These routines set the
; tag-flag which indicates to us now in what manner the file should be
; processed:  "00" = "skip it", "01" = process it", "02" = "perform a
; direct copy (if possible)", "FF" = "no more files".
;
NXTFIL:	LD	SP,TOPSTK	; 'just in case'
	LD	A,(QUIFM)	; conditional CR/LF depending on "quiet mode"
	OR	A
	CALL	Z,CRLF

	LD	DE,INFCB	; Input file fcb
	CALL	CLRFCB		; Init it to blanks and zeroes
	INC	DE		; Leave "DE" pointing at infcb+1 for below

	LD	HL,(BUFPTR)	; Pntr to name of next file from expansion bfr
NXTSEL:	LD	A,(HL)
	OR	A		; If zero, the file is "unselected"
	JR	NZ,ISSEL	; Br if it is selected
	LD	BC,12		; Else just quietly skip to the next file
	ADD	HL,BC
	LD	(BUFPTR),HL
	JR	NXTSEL
;
;...............................
;
ISSEL:	CP	0FFH		; An "FF" means done
	JP	Z,RETCCP	; Br if that is the case

	PUSH	AF		; Save stat (to see if file is "excluded" blw)

	PUSH	DE
	LD	DE,DASHES	; "-----" for visual separation
	CALL	MESAG2
	POP	DE
	INC	HL		; Skip to 1st filename char
	LD	BC,11		; Filename character count
	LDIR			; Put next file name into input fcb
	LD	(BUFPTR),HL	; Save new pointer for next file
	CALL	INTRAM		; Initialize all ram
	LD	A,80H		; (init'd by "INTRAM", but must be init'd
	LD	(CSAVE),A	; - differently for CRUNCH & UNCRunch)
	POP	AF		; Get file's status byte back again
	CP	02H		; 02 if file matched the "exclusion" list
	JR	NZ,COPNIN	; If not, definitly attempt to uncompress it
	LD	A,(WLDFLG)	; If so, see if prgm was invoked w/ wildcards
	OR	A		;
	JP	NZ,COPY9	; If so, do not uncompress; do a straight copy
;
;.......................................................................
;
; Now open the input file.  A failure here is unusual, since the file
; existed at the time the filename expansion took place.  There are
; "normal" series of events which could lead up to this, however.
;
COPNIN:	CALL	OPNIN		; Attempt to open the next input file "INFCB"
	JR	NC,OPOK		; Br if ok
	LD	DE,ERR1		; "input file not found"
	JP	SKIP1		; Skip to next file
;
;.......................................................................
;
; If we got here, the input file is open.  The output file is not
;
OPOK:	LD	DE,OUTFCB	; Now for the output fcb
	CALL	CLRFCB		; Clear it
	INC	DE		; Leave "DE" pointing at filename area
	LD	A,' '		; For proper alignment
	CALL	TYPE
	LD	HL,INFCB	; Print input filename to console
	CALL	PRNFIL
	XOR	A		; Init 1st char of date stamp bfr to zero
	LD	(STAMP),A	; (nulls the buffer; zero is the eof char)
	CALL	GETCHR		; Get a char from the input stream
	JR	NC,NTMT		; If carry set on first byte, file is empty
	LD	DE,ERR0		; "[ file empty ]"
	JR	NCR2		; Treat same as "Not compressed"

NTMT:	CP	76H		; Check for crunched file header "76FE"
	JR	NZ,NCRNCH	; Br if not
	CALL	GETCHR
	CP	0FEH
	JR	Z,YCRNCH
	CP	0FFH		; Squeezed?
	JR	Z,YESQZ		; Br if so

NCRNCH:	CALL	CLSIN		; Not squeezed or crunched; close input file
	LD	DE,MSG43	; "[not compressed]"

NCR2:	CALL	MESAG2
	LD	A,(WLDFLG)	; Invoked w/ wildcards?
	OR	A
	JP	NZ,COPY9	; Do straight copy ("copy" chks for diff du)
	JP	NXTFIL		; Else go on to next file
;
;...............................
;
YESQZ:	LD	(SQZFLG),A	; Flag file as squeezed using ff already in a
	CALL	GETCHR		; Get checksum byte #1
	LD	L,A		; Hold that
	CALL	GETCHR		; Checksum byte #2
	LD	H,A
	LD	(SQCKSM),HL	; Save for later reference

YCRNCH:	LD	DE,OUTFCB+1	; Where output filename will be copied to
	LD	B,12		; Loop limiter (11 char filename + ".")

EATLP:	CALL	GETCHR		; Get next char
	OR	A		; A zero byte indicates end of filename
	JR	Z,ATEIT		; Br when that is encountered
	AND	7FH		; Force valid ascii (should be already)
	CALL	UCASE		; Upcase the char- (may be lc if squeezed)
	CP	'.'		; Check for name / ext division char
	JR	Z,ISDOT		; Br when encountered
	LD	(DE),A		; Else copy char to output fcb
	INC	DE		; And incr that pointer
	DJNZ	EATLP		; Continue, but not past end of filename
	JR	IGNORE		; If no 0 detected, ignore following info
;
;.......................................................................
;
; When "." is encountered, skip to the file extension bytes of the out-
; put FCB.  Any remaining non-extension bytes were init'd to blank).  Do
; not copy the "." to the output FCB.
;
ISDOT:	LD	DE,OUTFCB+9	; Skip...
	LD	B,3		; Update loop limiter counter
	JR	EATLP		; And continue
;
;...............................
;
IGNORE:	LD	A,(SQZFLG)	; For squeezed files, nothing else to do
	OR	A
	JP	NZ,USQZIT	; Go to it

IGNRLP:	CALL	GETCHR		; Loop absorbs extraneous header info
	JR	C,NCRNCH	; Circumvent possible hangup (eof before 0)
	OR	A		; Wait for the terminating zero
	JR	Z,ATEIT		; If terminating zero is reached
	CP	'['		; Else check for date stamp bof char
	JR	NZ,IGNRLP	; Other chars are extraneous at this point
;
;...............................
;
	LD	DE,STAMP	; Start copying file stamp info to this buffer
	JR	ENTSLP

STMPLP:	CALL	GETCHR		; Get a char
	JR	C,NCRNCH	; Circumvent hangup
ENTSLP:	LD	(DE),A		; Put char in dest
	INC	DE		; Incr dest pntr
	OR	A
	JR	NZ,STMPLP	; Loop till zero is reached
;
;...............................
;
ATEIT:	CALL	GETCHR		; Get revision level, do nothing with it
	CALL	GETCHR		; Get significant revision level
	CP	SIGREV		; Compare to this prog
	JP	C,OLDTYP	; Br if old type1x crunched file
	JR	Z,SIGOK		; If equal, ok, else...
	LD	DE,ERR5		; "can't uncrunch that file. newer revision of
	JP	SKIP2		; - this program needed" or some such remark

SIGOK:	CALL	GETCHR		; Get checksum flag
	LD	(CKSMFL),A	; Put it there
	CALL	GETCHR		; Get spare byte, do nothing with it
	CALL	OPNOUT		; Open output file & type "--->  <filename>"
	PUSH	AF		; Save stat from above
	CALL	PRNID		; Type any embedded date stamp info also
	POP	AF
	JP	C,SKIP2A	; If user wants to skip it
;
;.......................................................................
;
; Now both files are open.  Eventually either both will be closed, or
; the input file will be closed and the output deleted.
;
	LD	A,(QUIFM)	; Skip column headings if in quiet mode
	OR	A
	JR	NZ,QUIET1
	LD	DE,HEADNG	; Type all the "in / out  ca  cr" stuff
	CALL	MESAGE

QUIET1:	CALL	INITB2		; Initialize the lzw table
	LD	DE,NOPRED	; Init to "NOPRED" (null value)
;
;=======================================================================
;
;		 *** Main Decoding loop(s). ***
;
;=======================================================================
;
MAINLP:	LD	(LASTPR),DE	; Always keep a copy of the last "pred" here
	CALL	GETCOD		; Get bits to form a a new code in "DE"
	JP	C,DUN		; Br if eof node or physical end-of-file
	PUSH	DE		; Push a copy of the new pred
	CALL	DECODE		; Decode new pred
	LD	HL,ENTFLG	; Flag is "01" if "decode" made the entry
	SRL	(HL)		; Check (and zero) the flag
	JR	C,NOENTR	; Don't make the same entry twice!
	LD	HL,(LASTPR)	; Get old pred
	LD	A,(CHAR)	; And suffix char generated from the new pred
	CALL	ENTERX		; Make new table entry from those two

NOENTR:	POP	DE		; Get newest pred again (not that new anymore)
	LD	A,(FULFLG)	; Monitor the table full flag
	OR	A
	JR	Z,MAINLP	; Continue decoding & entering 'till full
;
;...............................
;
	CP	0FEH		; When this becomes "FF", we are done
	JR	NZ,FASTLP	; First it will become "FE", though. in that
	INC	A		; - case perf 1 more loop & change it to "FF"
	LD	(FULFLG),A	;
	JR	MAINLP		; One more!
;
;.......................................................................
;
FASTLP:	LD	(LASTPR),DE	; Table full loop similar to above ,except
	CALL	GETCOD		; - don't bother checking table full flag
	JP	C,DUN		; - call "ENTFIL", not "ENTERX" (for possible
	PUSH	DE		; - code reassignment
	CALL	DECODE		; Call to actually decode chars
	LD	HL,(LASTPR)	; Get old pred
	LD	A,(CHAR)	; And suffix char generated from the new pred
	CALL	ENTFIL		; Possibly make new table entry from those two
	POP	DE
	JR	FASTLP		; Continue in code reassignment mode
;
;		*** End of Main Processing Loop(s)
;_______________________________________________________________________
;
; Come here when one of the special codes is encountered (we may not
; really be "dun").  Actually, a null code should have been intercepted
; by the GET12 routine, leaving only EOF (actually done) or adaptive
; reset.
;
DUN:	LD	A,E		; Some kind of special code encountered
	CP	LOW(EOFCOD)	; Actually done?
	JR	Z,DUNDUN	; Br if do
	CP	LOW(RSTCOD)	; Else better be reset (null was intercepted)
	JP	NZ,FATBAD	; File is invalid
;
;.......................................................................
;
; --- Perform an adaptive reset ---
;
	LD	HL,0000		; Reset entry# prior to table re-initialization
	LD	(ENTRY),HL
	LD	(TTOTAL),HL	; Reset "codes reassigned"
	XOR	A
	LD	(FULFLG),A	; Reset  "table full" flag
	CALL	INITB2		; Reset the entire table
	LD	A,9		; Reset the code length to "9"
	LD	(CODLEN),A
	LD	A,02H		; Reset the target mask value accordingly
	LD	(TRGMSK),A

	LD	DE,NOPRED	; Set pred to "nopred"
	LD	A,1		; 1st entry is always a special case
	LD	(ENTFLG),A	; (trick it to make no table entry)
	JP	MAINLP		; And continue where we left off
;
;_______________________________________________________________________
;
; --- Actually done, close things up ---
;
DUNDUN:	CALL	GETCHR		; Get the checksum, always next
	LD	E,A
	CALL	GETCHR		; Get checksum (hi-byte)
	LD	D,A		; Checksum (from input file) now in "DE"
	LD	A,(CKSMFL)	; Checksum override flag (not currently used)
	AND	A		; Check flag, also clear carry for below
	JR	NZ,CHKSOK	; If flag > 0, don't check checksum

DUNDUQ:	LD	HL,(CHKSUM)	; Checksum (as computed)
	SBC	HL,DE		; Else check by subtraction
	JR	Z,CHKSOK	; Br if match
	LD	DE,BADCHK	; Bad checksum, issue warning
	CALL	MESAGE
;
;...............................
;
CHKSOK:	CALL	DONE		; Write out remaining output buffer

CLOSE2:	CALL	CLSOUT		; Close output file
	CALL	CLSIN		; Close input file
	JR	NEXT
;
;.......................................................................
;
COPY9:	CALL	COPY		; Perform a straight copy
	JP	C,NXTFIL	; If copy didn't take place, don't count it

NEXT:	LD	HL,NFP		; If we got here, the file has been "processed"
	INC	(HL)		; So incr the "files processed" counter
	JP	NXTFIL		; Go start next file
;
;.......................................................................
;
;...............................
;
SKIP1:	CALL	MESAGE		; Entry if neither in nor output files open yet

SKIP1A:	JP	NXTFIL		; (Entry here if no error text desired)
;
;...............................
;
SKIP2:	CALL	MESAGE		; Entry here if input file open only

SKIP2A:	CALL	CLSIN		; (Entry here for no message)
	JP	NXTFIL
;
;...............................
;
SKIP3:	CALL	MESAGE		; Entry here if in & output files to be closed

SKIP3A:	CALL	CLSOUT		; (Rest is same as above)
	CALL	CLSIN		;
	JP	NXTFIL
;
;...............................
;
SKIP4:	CALL	MESAGE		; Entry here to erase output & close input file

SKIP4A:	CALL	CLSOUT		; (Entry here for no message)
	LD	DE,OUTFCB	; Erase ouptut file, already started
	LD	C,ERASE
	CALL	BDOSAV
	CALL	CLSIN		; Close input file as well
	JP	NXTFIL
;
;...............................
;
;.......................................................................
;
; The following routine actually performs the decoding.  The top section
; "DECODE" flags the entry as "referenced".  It then calls the recursive
; section below it, "DECODR", to do the actual work.
;
DECODE:	PUSH	DE		; Save code. the code provides us an immediate
	EX	DE,HL		;   index into the main logical table

	LD	A,H		; (Add offset to beg of table, of course)
	ADD	A,TABLHI
	LD	H,A
	SET	5,(HL)		; Set bit 5 of pred (hi) to flag entry as
	POP	DE		; - "referenced" (ie not bumpable)
;
;.......................................................................
;
DECODR	EQU	$		; Decode and output the index supplied in "DE"
;
	LD	IY,STKLIM	; Stack overflow check as a safety precaution
	ADD	IY,SP		; (limit allows extra for this invocation lvl)
	JP	NC,STKOVF	; Br on overflow (shouldn't happen)

	PUSH	HL		; Only "HL" need be saved

	LD	A,D		; Convert index in "DE" to address in "HL"
	ADD	A,TABLHI
	LD	H,A
	LD	L,E		; Address now in "HL"

	LD	A,(HL)		; Make sure the entry exists
	AND	0DFH
	CP	80H		; (Value for a vacant entry)
	JR	NZ,OK1		; Br if so (normal case)
;
;...............................
;
	LD	A,01H		; The "ugly" exception, wswsw
	LD	(ENTFLG),A	; Set flag so entry isn't made twice
	PUSH	HL		; Save current stuff.
	LD	HL,(LASTPR)	; Get the last pred..
	LD	A,20H		; (setting this flag will flag the entry as
	LD	(FFFLAG),A	; - referenced,)
	LD	A,(CHAR)	; Get the last char
	CALL	ENTERX		; Make an on the fly entry...
	XOR	A
	LD	(FFFLAG),A	; Put this back to normal
	POP	HL		; And presto...
	LD	A,(HL)		; It had better exist now!
	CP	80H
	JR	Z,FATBAD	; *** else file is fatally invalid ***
;
;...............................
;
OK1:	LD	D,(HL)		; Normal code- get "pred" (hi)
	RIGHT1			; Move to "pred" (lo)
	LD	E,(HL)		; Get that. if MSB of hi byte is set, val must
	BIT	7,D		; - be "FF" (nopred) because it isn't "80H"
	JR	NZ,TERM		; If so, branch. this terminates recursion.
	RES	5,D		; Else clear flag bit & decode pred we found
	CALL	DECODR		; Decode and output the "pred" (recursive call)
	RIGHT1			; Move pointer ahead to the "suffix" byte
	LD	A,(HL)		; Get it

SAMABV:	CALL	SEND		; Output the "suffix" byte
	POP	HL		; Restore reg and return
	RET

TERM:	RIGHT1			; Move pointer ahead to the suffix byte
	LD	A,(HL)		; Get it & save it. it is the 1st char of the
	LD	(CHAR),A	; - decoded string, and will be used later to
	JR	SAMABV		; - attempt to make a new table entry.
				; (rest is same as above)
;
;_______________________________________________________________________
;
FATBAD:	LD	DE,ERR4		; "invalid crunched file"
	JP	CHKSOK		; Write out whatever we have, then next file
				; (Stack gets reloaded before next file)
;
;_______________________________________________________________________
;
; Enter { <pred>, <suffix> } into the table, as defined in { HL, A }
;
ENTERX:	PUSH	AF		; Save the suffix till we're ready to enter it
	PUSH	HL		; Save pred, xferred to "DE" just below
	CALL	FIGURE		; Puts result in "phyloc" only, affects nothing
	POP	DE		; Put pred in "DE" (pushed as "HL" above)
	LD	HL,(ENTRY)	; Get next avail entry#
	LD	A,H		; Convert that to an address
	ADD	A,TABLHI
	LD	H,A
;
; Entries are made here, but not normally flagged as "referenced" until
; the are received by "DECODE".  Until they are flagged as referenced,
; theyare "bumpable" i.e., available for code reassignment.  If "FFFLAG"
; is set to 20H, however, they will be flagged now.  This only occurs
; during initialization (bumping an atomic entry would be most unfortu-
; nate) and when a WsWsW string encounter initiates an emergency entry,
; despite the code never having been received by "DECODE".
;
	LD	A,(FFFLAG)	; Normally zero, as described above
	OR	D
	LD	(HL),A		; Make the entry- pred (hi) first
	RIGHT1			; Move to pred (lo) position
	LD	(HL),E		; Put that in
	RIGHT1			; Move to suffix position
	POP	AF		; Retrieve the suffix, saved on entry
	LD	(HL),A		; Stick it in
	LD	HL,(ENTRY)	; Increment the entry# counter
	INC	HL
	LD	(ENTRY),HL
	INC	HL		; See if a new code length is indicated. the
	LD	A,(TRGMSK)	; - extra inc "HL" above is to account for
	CP	H		; - skew delays of uncruncher vs. cruncher
	RET	NZ		; Normally just return

	SLA	A		; Change to a new code length
	LD	(TRGMSK),A	; This will be the next target mask
	LD	A,(CODLEN)	; Get the old code length, as a #of bits
	INC	A		; Increment it, too
	CP	13		; Check for overflow (12 bits is the max)
	JR	Z,FLGFUL	; If so, flag table as full
	LD	(CODLEN),A	; Else this is the new code length
	RET
;
;...............................
;
FLGFUL:	LD	A,0FEH		; Flag table as full
	LD	(FULFLG),A
	RET
;
;.......................................................................
;
; Get the next code by stripping the appropriate #of bits off the input
; stream, based on the current code length "CODLEN".  If the code is
; "NULL", don't even return; just get another one.  If the code is one
; of the other special codes, return with the carry flag set. "Spare" is
; actually treated like a "null" for the time being, since it's use has
; yet to be defined.
;
GETCOD:	LD	DE,0000		; Init "shift register" to zero
	LD	A,(CODLEN)	; Get current code length
	LD	B,A		; Will be used as a loop counter
	LD	A,(CSAVE)	; "leftover" bits

GETLP:	SLA	A		; Shift out a bit
	CALL	Z,REF		; Refill when necessary
	RL	E		; Shift in the bit shifted out
	RL	D		; Likewise
	DJNZ	GETLP		; Loop for #of bits needed

	LD	(CSAVE),A	; Save "leftover" bits for next time
	LD	A,D		; If hi-byte = "01", we may have a special code
	DEC	A		; Set z if it was "1"
	AND	A		; Clr carry
	RET	NZ		; Rtn w/ clr carry if byte wasn't "01"
;
;...............................
;
	LD	A,E		; Else further analysis necessary
	CP	4		; Set carry on 100, 101, 102, 103
	RET	NC		; Else code is normal, rtn with clr carry
	CP	LOW(NULCOD)	; Is it the "NULL" code?
	JR	Z,GETCOD	; If so, just go get another code
	CP	LOW(SPRCOD)	; (treat the unimplemented "spare" like a null)
	JR	Z,GETCOD	; As above

	SCF			; < rtn with carry set indicating special code
	RET			; (presumably "EOF" or "reset")
;
;_______________________________________________________________________
;
; Routine to reload "A" with more bits from the input stream.  Note we
; pre-shift out the next bit, shifting in a "1" from the left.	Since
; the leftmost bit in the reg is a guaranteed "1", testing the zero
; stat of the  accumulator later is a necessary and sufficient condition
; for determining that all the bits in the accumulator have been used.
;
; The only things to be careful of is that the last bit is NOT used la-
; ter, and that the bit now in the carry flag IS used upon return from
; this	subroutine.  (This is the identical scheme used in USQFST.  An
; exact complement to it is incorporated for shifting bits out in the
; CRUNCH program).
;
REF:	CALL	GETCHR		; Get the char
	JR	C,PHYEOF	; Br if unexpected physical eof encountered
	SCF			; To shift in the "1" from the right
	RLA			; Do that, shifting out a "real" bit
	RET			; Rtn (with that real bit in the carry flag)
;
;_______________________________________________________________________
;
PHYEOF:	LD	SP,TOPSTK	; "Emergency exit"- reset stack
	LD	DE,UNXEOF	; "Unexpected eof."
	CALL	MESAGE
	JP	CHKSOK		; Write out what we have, then continue
;
;_______________________________________________________________________
;
; Send character to the output buffer, plus related processing
;
SEND:	EXX			; Alt regs used for output processing
	SRL	B		; If reg is "1", repeat flag is set
				; (note, clears itself automatically)
	JR	C,REPEAT	; Go perf the repeat
	CP	90H		; Else see if char is the repeat spec
	JR	Z,SETRPT	; Br if so
	LD	C,A		; Else nothing special- but always keep
	EXX			; Back to normal regs
	CALL	OUTC		; Else just output the char;
	RET
;
;.......................................................................
;
; Set repeat flag; count value will come as the next byte. (Note: don't
; clobber C with the "90H"- it still has the prev character, the one to
; be repeated)
;
SETRPT:	INC	B		; Set flag
	EXX			; Switch to primary regs & return.
	RET
;
;.......................................................................
;
; Repeat flag was previously set; current byte in a is a count value.
; A zero count is a special case which means send 90H itself.  Otherwise
; use B (was the flag) as a counter. The byte itself goes in A.
;
REPEAT:	OR	A		; Check for special case
	JR	Z,SND90H	; Jump if so
	DEC	A		; Compute "count-1"
	LD	B,A		; Juggle registers
	PUSH	BC		; The count and the char
	LD	B,0		; Zero the count in advance
	EXX
	POP	BC

AGAIN:	LD	A,C
	PUSH	BC
	CALL	OUTC		; Repeat b occurrences of byte in 'c'
	POP	BC
	DJNZ	AGAIN		; Leaves b, the rpt flag, 0 as desired
	RET
;
;...............................
;
SND90H:	LD	A,90H		; Special case code to send the byte 90h
	EXX
	CALL	OUTC
	RET
;
;.......................................................................
;
; Send the char in "A" to the output buffer and add it to the running
; checksum.
;
OUT	EQU	$
OUTC:	CALL	OUTB		; Output it
	CALL	CKSUM		; Add to the checksum
	RET
;
;_______________________________________________________________________
;
; Convert the middle letter of the filename extension to a "Z" if it is
; "?", AND "difdu" = 0.  If we are uncrunching to a different DU:, get
; all files.
;
FIXFCB:	LD	A,(DIFDU)
	OR	A
	RET	NZ		; If this flag is set, leave ext char untouched
	LD	HL,INFCB+10	; Point to middle letter of extension
	LD	A,'?'
	CP	(HL)		; See if it is ambiguous
	RET	NZ		; If not, we'll allow any letter (rev v1.2)
	LD	(HL),'Z'	; Else force it to "Z". this is mainly so
	RET			; The command line uncr *.* will work well
;
;_______________________________________________________________________
;
; Flag files to be copied, not uncompressed
;
EXCLUD:	LD	BC,12		; Leave 12 in bc for incrementing ix
	LD	IX,FNBUFF	; Points to beg of filenames

OUTLP:	LD	A,(IX+0)	; Get flag byte for this entry
	CP	0FFH		; Final [non-] entry?
	RET	Z		; (return if so)

	OR	A		; Is it an untagged filename?
	JR	Z,NXTFN		; If so, leave it that way & move to next
	LD	A,(IX+10)	; Otherwise check middle letter of fn ext
	CP	'Z'		;
	JR	Z,NXTFN		; If 'z', do not exclude it
	CP	'Q'		;
	JR	Z,NXTFN		; Likewise 'q', else "exclude" it
;
;-----------------------------------------------------------------------
;
AUTOM3:	LD	A,02H		; Flag file as "excluded"
	LD	(IX+0),A

NXTFN:	ADD	IX,BC		; Move to next filename in "fnbuff"
	JR	OUTLP
;
;_______________________________________________________________________
;
; Type the stuff in the "stamp" buffer to the console.
;
PRNID:	LD	DE,SPACE3	; Precede with 3 spaces
	CALL	MESAG2
	LD	HL,STAMP	; Point to that buffer
	LD	B,40		; Practical limit of 40 char "stamp"

PRFILP:	LD	A,(HL)		; Get a character
	OR	A		; Zero terminates the field
	RET	Z		; Return when encountered
	CALL	TYPE		; Else type the char
	CP	']'		; This terminates stamp also (after typing it)
	RET	Z		; Return if that happened
	INC	HL		; Else incr pointer
	DJNZ	PRFILP		; And loop
	RET
;
;_______________________________________________________________________
;
STKOVF:	LD	DE,ERR6		; "*** stack overflow ***"
	LD	SP,TOPSTK	; Shouldn't happen, but we're still in control
	JP	FATBAD		; Reset and continue with next file, if any
;
;_______________________________________________________________________
;
; Initialize the table to contain the 256 "atomic" entries - { "NOPRED",
; <char> },  for all values of <char> from 0 thru 255
;
INITB2:	CALL	PRESE2		; "pre-initializes" the table (mostly zeroes)
	LD	A,20H
	LD	(FFFLAG),A
	XOR	A		; Start with a suffix of zero
	LD	HL,NOPRED	; Pred for all 256 atomic entries

INILP:	PUSH	HL
	PUSH	AF
	CALL	ENTERX
	POP	AF
	POP	HL
	INC	A		; Next suffix
	JR	NZ,INILP	; Loop 256 times
;
;.......................................................................
;
; Now reserve the four reserved codes 100H - 103H (EOF, RESET, NULL, and
; SPARE.  This is easily achieved by inserting values in the table which
; cannot possibly be matched, and insuring that they cannot be reas-
; signed.  An occurrence of any of these codes is possible only when the
; cruncher explicitely outputs them for the special cases for which they
; are designated.
;
	LD	B,4		; Loop counter for the 4 reserved entries

RSRVLP:	PUSH	BC
	LD	HL,IMPRED	; An "impossible" pred
	XOR	A		; Any old suffix will do
	CALL	ENTERX		; Make the entry
	POP	BC
	DJNZ	RSRVLP		; Loop 4 times

	XOR	A		; Now restore this flag to its normal value
	LD	(FFFLAG),A
	RET
;
;.......................................................................
;
; Low-level table preset called before initialization above. This rou-
; tine presets the main table as follows: (see description of table
; elsewhere):  Column 1: 4096 x 80H, Columns 2 and 3: 4096 x 00H
;
PRESE2:	LD	HL,TABLE	; Beginning of main table, 4096 rows x 3 columns
	LD	DE,TABLE+1
	LD	BC,1000H
	LD	(HL),80H
	LDIR			; Put in 1000h "80H"'s
	LD	(HL),0		;
	LD	BC,2*1000H-1	; Note "-1"
	LDIR			; And 2000h more "00H"'s
;
;.......................................................................
;
; The auxiliary physical translation table is 5003 rows 2 columns
; (logically speaking).  Actually 5120 rows, 2 columns are allocated.
; All entries are initialized to 80H.
;
	LD	HL,XLATBL	; Physical <--> logical xlation table
	LD	DE,XLATBL+1
	LD	BC,2800H	; Total entries = 1400h x 2
	LD	(HL),80H
	LDIR
	LD	A,7FH
	LD	(XLATBL+0),A
	RET
;
;_______________________________________________________________________
;
; Figure out what physical location the cruncher put its entry by repro-
; ducing the hashing process.  Insert the entry# into the corresponding
; physical location in XLATBL.
;
FIGURE:	LD	B,A		; < suffix supplied goes into B
	CALL	HASH		; Get initial hash value into  "HL"

PHYLP:	LD	C,H		; C  <-- extra copy of h
	LD	A,(HL)		; Check if any entry exists at that location
	CP	80H		; Value for a vacant spot
	JR	Z,ISMT		; Br if vacant
	CALL	NM		; Else find next in chain
	JR	PHYLP		; And continue
;
;...............................
;
ISMT:	LD	DE,(ENTRY)	; Get the logical entry#
	LD	(HL),D		; Stick in hi-byte
	LD	A,H		; Move "right1" for this table
	ADD	A,14H
	LD	H,A
	LD	(HL),E		; Low-byte goes there
	RET
;
;...............................
;
NM	EQU	$		; No match yet... find next "link" in chain
;
	LD	DE,(DISP)	; Secondary probe- add disp computed by "HASH"
	ADD	HL,DE
	LD	A,H
	CP	XLATBH		; Check for loop around
	JR	NC,NC9		; Br if not
	LD	DE,5003		; Else loop
	ADD	HL,DE

NC9:	RET
;
;.......................................................................
;
ENTFIL	EQU	$		; Try to enter the pred/suffix in HL|A
;
	CALL	HASH		; Get initial hash value into  "HL"
;
;.......................................................................
;
PHYLP2:	LD	A,(HL)		; Check if any entry exists at that location
	CP	80H		;
	RET	Z		; End of chain, return w/o reassignment
;
;...............................
;
	PUSH	HL		; Save physical table pointer
	LD	D,(HL)		; Get entry#, hi
	LD	A,H		; }
	ADD	A,14H		; } right 1 for this table
	LD	H,A		; }
	LD	L,(HL)		; Entry#, lo byte
	LD	A,D
	ADD	A,TABLHI	; Convert to an addr in "HL"
	LD	H,A
	BIT	5,(HL)		; See if entry is bumpable
	JR	Z,MAKIT		; If so bumpable, go do it
	POP	HL		; Else restore physical tbl pointer
	CALL	NM		; Find next "link" in chain
	JR	PHYLP2		; And continue
;
;.......................................................................
;
; Reassign the entry pointed to by "avail", if any. Re-define the "last
; pred entered" and "last suffix" variables.
;
MAKIT:	POP	DE		; Get rid of extraneous physical pointer
	LD	DE,(TTOTAL)	; Increase user's display count
	INC	DE
	LD	(TTOTAL),DE
	LD	DE,(LASTPR)	; Get the pred
	LD	A,(CHAR)	; And suffix
	LD	B,A		; Put suffix here, ("right1" kills a)
	LD	(HL),D		; Actually make the entry
	RIGHT1
	LD	(HL),E		; [pred(lo)]
	RIGHT1
	LD	(HL),B		; [suffix]
	RET			; Done
;
;.......................................................................
;
; For additional details about the hashing algorithm, see CRUNCH.
;
HASH	EQU	$
;
	LD	E,L		; Save so low-nybble of pred can be used below
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL		; Shift whole pred value left 4 bits
	XOR	H		; Xor hi-byte of that with suffix
	LD	L,A		; Goes there as lo-byte of result
	LD	A,E		; Get pred(lo) saved above
	AND	0FH		; Want only low nybble of that
	ADD	A,XLATBH	; Convenient time to add in table offset
	LD	H,A		; Goes here as hi-byte of result
	INC	HL		; Except add one. this eliminates poss. of 0.
	PUSH	HL		; Save hash val for return
	LD	DE,-5003-XLATBL	; Compute displacement value, - (5003-hash)
	ADD	HL,DE		; (displacement has table offset removed again)
	LD	(DISP),HL	; Secondary hashing value, a negative number.
	POP	HL		; Get back orig hash address
	RET			; And return it
;
;=======================================================================
;
; For old style (v1.x) type crunched files, simply call the "UNCR1"
; module.  Squeezed files are handled identically, except call "USQREL"
; module.  All I/O will be done by this program - UNCR1 will get and
; feed data through calls to entry points "GETBYT" and "OUT".
;
OLDTYP:	CALL	GETCHR		; Get checksum flag
	LD	(CKSMFL),A	; Put it there
	CALL	GETCHR		; Get spare byte, do nothing with it *** nec??

USQZIT:	LD	A,0FFH		; Flag this as an old style uncrunch
	LD	(OLDFLG),A	; (controls type of screen updating)
	CALL	OPNOUT		; Open output file & type "--->  <filename>"
	PUSH	AF		; Save stat from abv call
	LD	A,(SQZFLG)	; *** necessary?
	OR	A
	CALL	Z,PRNID		; Type any embedded date stamp info also
	POP	AF		; Get back carry stat
	JP	C,SKIP2A	; If user wants to skip it
	CALL	CRLF		; More aesthetics
	EXX			; Go back to start of file (already read some)
	LD	HL,IBUF
	EXX

FIX21:	LD	HL,SECNT	; Bugger up the sector count since we just
	INC	(HL)		; - reset the input pointer
	LD	HL,(INCTR)	; [rev 2.1 fix]
	DEC	HL		; Decr "inctr" for same reason
	LD	(INCTR),HL
	LD	A,'0'		; [Rev 2.1 fix]
	LD	(PROGBF+5),A	; Reset ascii display to zero
	LD	HL,TABLE	; Point to large data area for uncr1
	LD	A,(SQZFLG)
	OR	A
	JR	NZ,USESQZ	; If squeezed, call usqrel rather than uncr1
	CALL	UNCR1		; Uncrunch the whole thing

ABVQ:	JP	NC,DUNDUN	; A "normal" return
	JP	FATBAD		; Any other error falls under "invalid.."

USESQZ:	CALL	USQREL		;
	LD	DE,(SQCKSM)	; Get checksum read at beginning of file
	JP	NC,DUNDUQ	; Terminate similarly (w/o reading cksm bytes)
	JP	FATBAD
;
;_______________________________________________________________________
;
PRCSTM:	LD	DE,PRSER1	; "invalid argument" (no stamps allowed)
	JP	FATALU
;
;_______________________________________________________________________
;
UCASE:	CP	'a'		; Upper-case character in A
	RET	C
	SUB	20H		; (Note "{","|","}",and "~" cannot occur)
	RET
;
;_______________________________________________________________________
;
VUNITS	EQU	(REV/16)+'0'	  ; Version, units dig, in ascii
VTNTHS	EQU	(REV AND 0FH)+'0' ; Version, tenths dig, in ascii

INTRO:	DB	'GEL Uncruncher v',VUNITS,'.',VTNTHS,CR,LF,'$'
BADCHK:	DB	'Checksum error detected.',CR,LF,'$'
MSG43:	DB	'    [ Not compressed ]',CR,LF,'$'
ERR4:	DB	'Invalid Crunched File.',CR,LF,'$'
ERR5:	DB	'File requires newer program rev.',CR,LF,'$'
ERR6:	DB	'Stack Overflow.',CR,LF,'$'
SPACE3:	DB	'   $'
UNXEOF:	DB	'Unexpected EOF.',CR,LF,'$'

USAGE:	DB	CR,LF,'Usage:',CR,LF,LF

	DB	'                Filename   (space)',CR,LF
	DB	'               /            |',CR,LF
	DB	' UNCR  {du:}<afn>  {du:}   { /<options> }',CR,LF
	DB	'         \           \             \',CR,LF
	DB	'          Source      Destination   Option letters'
	DB	CR,LF,LF
	DB	' <options> is up to 3 letters immediately following a " /".',CR,LF
	DB	' "Q" = Quiet mode  "C" = Confirm (tag) mode  "O" = Overwrite mode',CR,LF
	DB	' Option letters toggle (reverse) the corresponding default setup.',CR,LF
	DB	CR,LF
	DB	' Both "du:" are of form DU:, UD:, D:, or U:',CR,LF
	DB	CR,LF
	DB	'  Everything is optional except filename.',CR,LF,LF,'$'
;
;_______________________________________________________________________

	INCLUDE	COMMON.LIB
;_______________________________________________________________________
;
; Additional miscellaneous ram locations which need not be initialized
; or are initialized by the routines which use them.
;
CKSMFL:	DS	1		; Skip checksum if flag non-zero
CHAR:	DS	1		; Last char of the previously decoded string
FFFLAG:	DS	1
CSAVE:	DS	1
SQCKSM:	DS	2
;
;...............................
;
STKSZ	EQU	8		; Minimum stack size (pages)
IBUFSZ	EQU	8		; Input buffer size (pages)
;
;=======================================================================
;
; ===>	All tables will begin at "MEMPAG", defined at the top of the
;	program.  This should be set to a page aligned value i.e., ad-
;	dress that ends  in "00", which is ABOVE the end all program
;	and data segments.  You may have to do one test link to deter-
;	mine the proper value (changing "MEMPAG" will not change the
;	length of the segments on the subsequent link).
;
; "MEMPAG" is defined at the beginning of this program to remind you to
; set it properly.  If you set it higher than necessary, there will be
; no negative effect other than an increase in the TPA required to run
; the program.	If you set it too low, you will be in big trouble.  The
; value must be set manually because most linkers cannot resolve an
; "and", "shift", or "hi" byte extraction at link time to determine the
; page boundary.
;
;=======================================================================
;
; "MAXFLS" is  buffer size (in files) for wildcard expansions.	Room for
; this many files will be allocated.
;
MAXFLS	EQU	256

FNBUFF	EQU	MEMPAG		   ; (= beg of wildcard expansion buffer)
ENDFNB	EQU	FNBUFF+(12*MAXFLS) ; End of expansion buffer

IBUF	EQU	ENDFNB		   ; (= beg of input buffer)
EIBUF	EQU	IBUF+(IBUFSZ*256)  ; End of input buffer

TABLE	EQU	EIBUF		   ; (= beg of table)
EOTBL	EQU	TABLE+(3*1000H)	   ; End of table
XLATBL	EQU	EOTBL
EXLATB	EQU	XLATBL+(2*1400H)
STAMP	EQU	EXLATB		   ; 80h bytes for "stamp" buffer
ESTAMP	EQU	STAMP+80H

SAFETY	EQU	ESTAMP		   ; Safety region- beyond legal bottom of stack
BOTSTK	EQU	SAFETY+80H	   ; "Legal" stack limit
TOPSTK	EQU	EXLATB+(STKSZ*256) ; Top of stack

ENDALL	EQU	TOPSTK		   ; End of everything, except output buffer
OBUF	EQU	ENDALL		   ; Beginning of dynamically sized output buffer
;
;.......................................................................
;
STKLIM	EQU	0-BOTSTK	; Negation of "botstk", used as safety check

IBUFHI	EQU	HIGH IBUF	; Input bfr addr, hi byte (lo byte = 0)
EIBFHI	EQU	HIGH EIBUF	; End of input bfr addr, hi byte, likewise
TABLHI	EQU	HIGH TABLE	; Beg of table, hi byte, likewise
ETBLHI	EQU	HIGH EOTBL	; End of table, hi byte, likewise
XLATBH	EQU	HIGH XLATBL
EFNBHI	EQU	HIGH ENDFNB	; End of expansion buffer, likewise
ENDHI	EQU	HIGH ENDALL	; End of everything, likewise
OBUFHI	EQU	HIGH OBUF	; Output buffer address, hi byte likewise

	END