; UNARCZ -- CP/M Archive File Extractor
;
Vers	equ	10		; 11 Mar 90
;
; This ZCPR3 version of UNARC is based on Robert Freed's version 1.6.
; For details of the modifications see the history file.
;	Gene Pizzetta		Voice:  (617) 284-0891
;	481 Revere St.		Newton Centre Z-Node:  (617) 965-7259
;	Revere, MA 02151
;
; (Remember to update version/date here and maintain history log)
;
; Copyright (C) 1986, 1987 by Robert A. Freed
;
; NOTICE:  This program is the copyrighted property of its author -- it
; is NOT in the public domain.  HOWEVER...  Free use, distribution, and
; modification of this program is permitted (and encouraged), subject to
; the following conditions:
;
; (1) Such use or distribution must be for non-profit purposes only.
; (2) The author's copyright notice may not be altered or removed.
; (3) Modifications to this program may not be distributed without
;     notification of and approval by the author.
; (4) The source program code may not be used, in whole or in part,
;     in any other publicly-distributed or derivative work without
;     similar notification and approval.
;
; No fee is requested or expected for the use and distribution of this
; program subject to the above conditions.  The author reserves the right
; to modify these conditions for any future revisions of this program.
; Questions, comments, suggestions, commercial inquiries, and bug reports
; or fixes are welcomed by the author:
;
;		Bob Freed
;		62 Miller Rd.
;		Newton Centre, MA  02159
;		Telephone (617) 332-3533
;
; Modification history has been moved to a separate file.
;
; Credits:
;
; Primary credit is due to System Enhancement Associates' ARC author
; Thom Henderson for his fine utility program (even if it's not for
; CP/M).  Of course without ARC, UNARC would have no reason to exist.
; But special thanks are due SEA for making publicly available the C
; language source code, without which we could never have begun.
;
; For M80:
;	.Z80			; Sorry, if you're an Intel fan
;
; ARC file parameters

ARCMARK	EQU	26		; Archive header marker byte

; Note:	The following three definitions should not be changed lightly.
; These are hard-wired into the code at numerous places!

ARCVER	EQU	9		; Max. header vers. supported for output
CRBITS	EQU	12		; Max. bits in crunched file input codes
CQBITS	EQU	13		; Max. bits in squashed file input codes

; CP/M system equates

BOOT	EQU	0000H		; Base of system page / warm boot return
BDOS	EQU	BOOT+005H	; BDOS entry
MEMTOP	EQU	BDOS+1		; Contains base of BDOS / top of TPA
DFCB	EQU	BOOT+05CH	; Command line tail default FCB
SFCB	EQU	BOOT+06CH	; Command line tail secondary FCB
DBUF	EQU	BOOT+080H	; Default DMA buffer
TBASE	EQU	BOOT+100H	; Base of TPA

; BDOS function codes

$CONIN	EQU	1		; Console input
$CONOUT	EQU	2		; Console output
$LIST	EQU	5		; Listing output
$PRTSTR	EQU	9		; Print (console) string
$CONST	EQU	11		; Get console status
$VERSN	EQU	12		; Get CP/M version no.
$SELECT	EQU	14		; Select disk
$OPEN	EQU	15		; Open file
$CLOSE	EQU	16		; Close file
$FIND	EQU	17		; Find file
$DELETE	EQU	19		; Delete file
$READ	EQU	20		; Read sequential record
$WRITE	EQU	21		; Write sequential record
$MAKE	EQU	22		; Make file
$DISK	EQU	25		; Get current disk
$SETDMA	EQU	26		; Set DMA address
$GETDPB	EQU	31		; Get disk parameter block address
$CurUsr	equ	32		; get/set current user
$READR	EQU	33		; Read random record
$RECORD	EQU	36		; Set random record no.

; FCB offsets

@DR	EQU	0		; Drive code
@FN	EQU	1		; File name
@FT	EQU	9		; File type
@USR	equ	13		; user code
@CR	EQU	32		; Current record
@RN	EQU	33		; Random record no. (optional)
@FCBSZ	EQU	33		; FCB size for sequential I/O
@FCBSX	EQU	@FCBSZ+3	; Extended FCB size for random I/O

; Environment offsets
@WHL	equ	41		; address of wheel byte

; ASCII control codes

CTLC	EQU	'C'-'@'		; Control-C (console abort)
CTLK	EQU	'K'-'@'		; Control-K (alternate abort)
BEL	EQU	'G'-'@'		; Bell
HT	EQU	'I'-'@'		; Horizontal tab
LF	EQU	'J'-'@'		; Line feed
CR	EQU	'M'-'@'		; Carriage return
CTLS	EQU	'S'-'@'		; Control-S (suspend output)
CTLZ	EQU	'Z'-'@'		; Control-Z (CP/M end-of-file)
DEL	EQU	7FH		; Delete/rubout
REP	EQU	'P'-'@'+80H	; Repeated byte flag (DLE with msb set)
;
	ASEG			; This simplifies page alignment at end
;
	ORG	TBASE		; .COM file starts here
;
	JP	BEGIN		; Skip over this stuff on program entry
;
	db	'Z3ENV'		; ZCPR3 ID
	db	1		; external environment descriptor
Z3EAdr:	dw	0		; environment address
;
; Patchable Options -- These are primarily of interest to RCP/M sysops or
; users with non-standard (or very small) systems.  Options marked with
; "*" in comments below are automatically affected by the wheel byte setting.
; If WHEEL byte is zero, no file output allowed (as if HODRV = 0).  Also
; BLKSZ and/or TYPGS are assumed = 1, if these are zero by default.  If byte
; addressed by WHEEL is non-zero, TYFLG and TYLIM are not enforced (unlimited
; typeout allowed).

CCPSV:	DB	8		; No. high memory pages to save (8 = 2K)
;CCPSV:	DB	0		; This to clobber CCP and force reboot

;BLKSZ:	DB	1		; Default disk allocation block size (K)
BLKSZ:	DB	0		;*This to use default drive's block size
				;  for listing, when no output drive

HIDRV:	DB	'P'-'@'		; Highest input file drive (A=1,B=2,...)
;HIDRV:	DB	0		; This restricts input to default drive

HIUsr:	db	15		; highest user area for input
;HIUsr:	db	0		; Restricts input to current user (not user 0)

HODRV:	DB	'P'-'@'		;*Highest output file drive no.
;HODRV:	DB	0		; RCP/M's use this for no disk output
				;  (if no wheel byte implemented)

HOUsr:	db	15		; highest user area for output

TYFLG:	DB	0FFH		; This enables single file typeout
;TYFLG:	DB	0		;*RCP/M's use this for no file typeout

TYPGS:	DB	0		;*No. buffer pages for typeout (0=max)
;TYPGS:	DB	1		; This minimizes viewing waits, but may
				;  cause excess floppy motor stop/start

TYLIM:	DB	0		; No line limit for file typeout
;TYLIM:	DB	80		;*RCP/M's may prefer non-zero line limit

TYLPS:	DB	23		; No. lines between typeout pauses
;TYLPS:	DB	0		; Forces continuous typeout always

DBLSZ:	DB	0		; Use DPB for disk allocation block size
;DBLSZ:	DB	1		; Assumed block size (K) if BDOS 31 call
				;  not supported (e.g. CP/M-68K)

BELLS:	DB	0FFH		; Allow bells in warning/error messages
;BELLS:	DB	0		; This for solitude

; Table of file types which are disallowed for typeout

NOTYP:	DB	'COM'		; CP/M-80 or MS-DOS binary object
	DB	'CM','D'+80H	; CP/M-86 binary object (or dBASE file)
	DB	'EXE'		; MS-DOS executable
	DB	'OBJ'		; Renamed COM
	DB	'OV?'		; Binary overlay
	DB	'REL'		; Relocatable object
	DB	'?RL'		; Other relocatables (PRL, CRL, etc.)
	DB	'INT'		; Intermediate compiler code
	DB	'SYS'		; System file
	DB	'BAD'		; Bad disk block
	DB	'LBR'		; Library
	DB	'ARC'		; Archive (unlikely in an ARC)
	DB	'ARK'		; Alternate archive (ditto)
	DB	'?Q?'		; Any SQueezed file (ditto)
	DB	'?Z?'		; Any CRUNCHed (or ZOO'd) file (ditto)

; Note:  Additional types may be added below.  To remove one of the above
; types without replacing it, simply set the msb in any byte (as shown
; above for .CMD, since that can be a readable dBASE command file).

	db	0,0,0		; Room for more types (20 total)
	db	0,0,0
	db	0,0,0
	db	0,0,0
	db	0,0,0
	DB	0		; End of table

; Program usage displays if no command line parameters (Also, on attempts
; to type a COM file).  Note: All program name output is obtained from the
; first chars of the usage message below (up to and including the first
; blank), and is generated by a byte value 1 in any typeout string.

USAGE:	DB	'UNARCZ   '
	DB	'ZCPR3 Archive File Extractor   Version '
	db	Vers/10+'0','.',Vers mod 10+'0'
	DB	CR,LF
	DB	'Usage:',CR,LF
	db	'  ',1,'{dir:}arcfile{.typ} '
USE1:	DB	'{dir:}'
USE1L	EQU	$-USE1		; Above cleared if HODRV=0 or non-wheel
	DB	'{afn.aft} {{/}N'
USE4:	DB	'|P|C'
USE4L	EQU	$-USE4		; Above cleared if non-wheel
	DB	'}',CR,LF
	DB	'Examples:',CR,LF
	DB	'  B0>',1,'A3:SAVE.ARK *.*  '
	DB	'; List all files in CP/M archive SAVE in A3',CR,LF
	DB	'  B0>',1,'A0:SAVE.ARC *.*  '
	DB	'; List all files in MS-DOS archive SAVE in A0',CR,LF
	DB	'  A0>',1,'SAVE             '
	DB	'; Same as above',CR,LF
	DB	'  A0>',1,'SAVE *.* N       '
	DB	'; Same as above (no screen pauses)',CR,LF
	DB	'  A0>',1,'SAVE *.DOC       '
	DB	'; List just .DOC files',CR,LF
USE2:	DB	'  A0>',1,'SAVE READ.ME     '
	DB	'; Typeout the file READ.ME',CR,LF
	DB	'  A0>',1,'SAVE READ.ME /N  '
	DB	'; Typeout the file READ.ME (no screen pauses)',CR,LF
USE2L	EQU	$-USE2		; Above cleared if TYFLG=0 and non-wheel
USE3:	DB	'  A0>',1,'SAVE C3:         '
	DB	'; Extract all files to directory C3',CR,LF
	DB	'  A3>',1,'SAVE B:*.DOC     '
	DB	'; Extract .DOC files to directory B3',CR,LF
	DB	'  A0>',1,'SAVE 1:READ.ME   '
	DB	'; Extract file READ.ME to directory A1',CR,LF
USE3L	EQU	$-USE3		; Above cleared if HODRV=0 or non-wheel
USE5:	DB	'  A0>',1,'SAVE PRN.DAT P   '
	DB	'; Print the file PRN.DAT (no formatting)',CR,LF
	DB	'  A0>',1,'SAVE *.* C       '
	DB	'; Check validity of all files in archive'
USEC:	DB	CR,LF
USE5L	EQU	$-USE5		; Above cleared if non-wheel
	DB	LF
	DB	'Copyright (C) 1986, 1987 by Robert A. Freed'
; (We'd like to be unobtrusive, but please don't remove or patch out)
USEB:	DB	0		; End of message marker
	DB	CTLZ		; Stop attempted .COM file typeout here

; Beginnings and Endings
;
; Program begins -- The program is self-initializing.  Once loaded, it may
; be re-executed multiple times (e.g., by a zero-length COM file, or the
; ZCPR GO command).

BEGIN:	SUB	A		; (More elegant, saves a byte: v1.4)
	LD	C,$PRTSTR	; Setup to print message by BDOS
	LD	DE,NOTZ80	; Must be a Z80, or forget all else
	JP	PE,BDOS		; If not, just print message and abort
	LD	(SPSAV),SP	; Save CCP stack (better be a Z80 now!)
	CALL	CHECK		; Check if we can proceed
	LD	SP,STACK	; Now setup local stack
	LD	HL,TOTS		; Zero all listing totals
	LD	BC,TOTC*256+0
	CALL	FILL
	CALL	INIT		; Process command line, open ARC file
	CALL	OUTSET		; Check output drive, setup for output

; Find first archive header

	LD	HL,3		; Assume will skip at least 3 bytes
	LD	B,L		; Setup count of allowed extra bytes
FIRST:	CALL	GET		; Get next byte
	CP	ARCMARK		; Is it header marker?
	JR	Z,NEXT		; Yes, skip
	DJNZ	FIRST		; Else loop for no. allowed extras
; File processing loop
LOOP:	CALL	GET		; Get next byte
	CP	ARCMARK		; Is it archive header marker?
	JR	NZ,BAD		; No, it's a bad header

; Process next file
NEXT:	CALL	GET		; Get header version
	OR	A		; If zero, that's logical end of file,
	JR	Z,DONE		;  and we're done

NEXT1:	CALL	GETHDR		; Read archive header
	CALL	GETNAM		; Does file name match test pattern?
	JR	NZ,SKIP		; No, skip this file

	CALL	LIST		; List file info
	CALL	OUTPUT		; Output the file (possibly)
	CALL	TAMBIG		; Ambiguous output file selection?
	JR	NZ,EXIT		; No, quit early

; Skip to next file
SKIP:	LD	HL,SIZE		; Get two-word remaining file size
	CALL	LGET		; (will be 0 if output was completed)
	CALL	SEEK		; Seek past it
	LD	HL,0		; Reinit count of bytes skipped
	JR	LOOP		; Loop for next file

; Done with all files
DONE:	LD	HL,(TFILES)	; Get no. files processed
	LD	A,H
	OR	A
	JR	NZ,DONE1	; Skip if many

	OR	L		; No files found?
	LD	DE,NOFILS	; Yes, setup error message
	JR	Z,PABORT	;  and abort

	DEC	A		; Test if just one file
DONE1:	CALL	NZ,LISTT	; If more than one, list totals

; Exit program
EXIT:	CALL	ICLOSE		; Close input and output files (if open)
	LD	A,(CCPSV)	; Possibly overlaid CCP?
	OR	A
	JP	Z,BOOT		; Yes, reboot CP/M

	LD	SP,0		; Restore CCP stack
SPSAV	EQU	$-2		; (Original stack ptr saved here)
	RET			; Return to CCP

; Bad archive file header -- a bit kludgy, but does permit processing of
; Phil Katz' self-unpacking archive, PKX32A11.COM (with a warning message),
; as well as SEA's ARC51.COM (with no warning), although success with
; PKX32A11 hinges on the fact that no ARCMARK's are followed by valid
; non-zero versions in that file, which is probably coincidental.

BAD:	CALL	BADCNT		; Count bad header byte
	CALL	GET		; Read byte (unless end of file abort)
BAD1:	CP	ARCMARK		; Found a header marker?
	JR	NZ,BAD		; No, repeat attempt to re-synchronize

	CALL	GET		; Ok, found another (possible) header
	PUSH	AF		; Save header version
	DEC	A		; But ignore archive eof here
	CP	ARCVER		; Is it a valid version?
	JR	NC,BAD2		; No, skip

	EX	DE,HL		; Get count of bytes skipped
	LD	HL,HDRSKP	; Store in message
	LD	BC,0
	CALL	WTOD
	LD	(HL),0
	LD	DE,HDRERR	; Print warning message
	CALL	PRINTX
	POP	AF		; Recover version
	JR	NEXT1		; Go process (assumed valid) next file

BAD2:	CALL	BADCNT		; Count bad header byte (1st of 2 seen)
	POP	AF		; Restore vesion
	JR	BAD1		; Go check if 2 consecutive header marks

; Preliminary checks -- Following is called before local stack is setup.
; Primary caution here is that PRINT (called by PABORT and PEXIT) uses no
; more than 5 stack levels (assumes program called from CCP with 7 stack
; levels available, and that at most one of these must be reserved for
; interrupts).

CHECK:	XOR	A		; Clear flags in case early abort:
	LD	(IFLAG),A	;  Input file open flag
	LD	(OFLAG),A	;  Output file open flag
	LD	(LPS),A		; Prevent any screen pauses yet
	LD	C,$VERSN	; Must be CP/M 2.0 or above, since we
	CALL	BDOS		;  use random disk reads
	CP	20H
	LD	DE,CPMERR	; (With a bit of work, this limitation
	JR	C,EABORT	;  could be eliminated in future)

	LD	A,(MEMTOP+1)	; Get base page of BDOS
	LD	HL,CCPSV	; Subtract no. pages reserved for CCP
	SUB	(HL)		;  (if any)
	LD	(HIPAGE),A	; Save highest usable page (+1)
	LD	A,HIGH MINMEM	; Ensure enough memory to do anything

; Check for enough memory
CKMEM:	CP	0		; Page address to check in A
HIPAGE	EQU	$-1		; Must be lower than this
	RET	C		; Return if ok

	LD	DE,NOROOM	; Else, abort due to no room

; Early abort during preliminary checks
EABORT:	POP	HL		; Reclaim stack level for extra safety
PABORT:	CALL	PRINT		; Print error message and abort

; Abort program
ABORT:	LD	DE,ABOMSG	; Print general abort message

; Print message and exit -- calls PRINT+CRLF, instead of PRINTX, to save
; a stack level.

PEXIT:	CALL	PRINT
	CALL	CRLF
	JR	EXIT

; Initialize environment, validate command line parameters, and open
; input file

INIT:	ld	hl,(Z3EAdr)	; get environment address
	ld	de,@WHL		; offset to wheel byte
	add	hl,de
	ld	a,(hl)		; get address
	ld	(wheel),a	; ..and store it
	inc	hl
	ld	a,(hl)
	ld	(wheel+1),a
	LD	HL,DBUF+1	; Point to command line buffer
	ld	a,(dbuf)	; get length
	or	a		; anything there?
	jp	z,help		; (no)

	ld	c,a		; put count in BC
	ld	b,0
	call	EatSpc		; ignore spaces
	or	a		; at the end?
	jp	z,help		; (yes, give usage)

	cp	'/'		; request for help?
	jp	z,help

	ld	a,' '		; get past first token
	cpir
	jr	nz,init1	; (no option)
	call	EatSpc
	or	a		; at the end?
	jr	z,init1		; (yes)
	ld	a,' '		; get past second token
	cpir
	jr	nz,init1	; (no option)
	call	EatSpc
	or	a
	jr	z,init1
	cp	'/'		; delimiter?
	jr	nz,NoSlsh	; (nope)
	inc	hl		; yes, ignore it
	LD	A,(HL)
NoSlsh:	or	a
	jr	z,init1
	CP	'N'		; is it 'N'?
	JR	Z,INIT2		; Yes, skip (no paging)

	CP	'P'		; Is it 'P' ?
	JR	NZ,INIT0
	LD	(PROUTF),A	; Yes, set printer output flag
INIT0:	CP	'C'		; Is it 'C' ?
	JR	NZ,INIT1	; No, go enstate paging limit
	LD	(CHECKF),A	; Yes, set check archive flag
INIT1:	LD	A,(TYLPS)	; Fetch default lines between pauses
	LD	(LPS),A		; Set lines per screen (enables pauses)
	LD	(LPSCT),A	; Init count of lines until next pause
INIT2:	ld	a,(HIUsr)	; get maximum user code
	or	a		; is it zero?
	jr	nz,init2a	; (no)
	ld	c,$CurUsr	; yes, so get current user
	ld	e,0FFh
	call	Bdos
	ld	(DefUsr),a	; store it
init2a:	ld	a,(IFcb+@USR)	; get input file user code
	ld	(InUsr),a	; ..and save it
	ld	hl,InDrv+1	; point to string
	ld	b,2		; two digits max
	ld	c,0		; no leading spaces
	call	btod		; put it in ASCII string
	ld	a,':'		; store a colon
	ld	(hl),a
	inc	hl
	ld	a,0		; store final null
	ld	(hl),a	
	ld	a,(IFcb)	; do we have a input drive?
	cp	0
	jr	nz,init2b	; (yes)
	ld	c,$disk		; no, get current disk
	call	Bdos
	inc	a		; make A=1
init2b:	add	a,'@'		; make it printable
	ld	(InDrv),a	; ..and store it
	ld	a,(SFcb+@USR)	; get output file user code
	ld	(OutUsr),a	; ..and save it too
	ld	hl,outdrv+1	; point to string
	ld	b,2		; two digits max
	ld	c,0		; no leading spaces
	call	btod		; put it in ASCII string
	ld	a,':'		; store a colon
	ld	(hl),a
	inc	hl
	ld	a,0		; store final null
	ld	(hl),a	
	LD	A,' '		; Setup blank for (several) tests
	LD	HL,SFCB		; Point to second parameter FCB
	LD	DE,OFCB		; Point to file output FCB
	LDI			; Save output drive, point to file name
	LD	DE,TNAME	; Set to save test pattern
	LD	BC,11		; Setup count for file name and type
	CP	(HL)		; Output file name specified?
	JR	NZ,INIT3	; Yes, go move it

	LD	H,D		; No, default to "*.*"
	LD	L,E
	LD	(HL),'?'	; (I.e. all "?" chars)
	INC	DE
	DEC	BC
INIT3:	LDIR			; Save test name pattern
	LD	HL,IFCB+@FT	; Point to ARC file type
	CP	(HL)		; Omitted?
	JR	NZ,INIT4	; Skip if not

	LD	(HL),'A'	; Yes, set default file type (.ARK)
	INC	HL
	LD	(HL),'R'
	INC	HL
	LD	(HL),'K'
	LD	(ARKFLG),A	; Set flag for alternate (.ARC) next
INIT4:	LD	HL,IFCB+@FN	; Any ARC file name?
	CP	(HL)
	jp	Z,HELP		; No, go show on-line help

	PUSH	HL		; Save name ptr for message generation
	CALL	FAMBIG		; Ambiguous ARC file name?
	LD	DE,NAMERR	; Yes, report error
INIT5:	jp	Z,PABORT	;  and abort

	POP	DE		; Recover ptr to FCB name
	LD	HL,ARCNAM	; Unparse name for message
	LD	C,' '		; (with no blanks)
	CALL	LNAME
	XOR	A		; Cleanup end of message string
	LD	(HL),A
	DEC	A		; Set to read a new record next
	LD	(GETPTR),A	; (initializes GET)
	ld	a,(HIUsr)	; get high input user
	or	a		; is it zero?
	jr	nz,Init5a	; (no, so check it)
	ld	a,(InUsr)	; yes, so get file user code
	ld	hl,DefUsr	; point to default user
	cp	(hl)		; are they equal?
	jr	z,Init5b	; (yes, continue)
	ld	de,BadIDr	; Nope!
	jp	PAbort

Init5a:	inc	a		; make it one higher
	ld	d,a		; save it
	ld	a,(InUsr)	; get max input user
	cp	d
	jr	c,Init5b	; (user okay)
	ld	de,badidr
	jp	pabort

Init5b:	ld	hl,IFcb		; point to ARC file FCB
	LD	A,(HIDRV)	; Get highest allowed drive no.
	CP	(HL)		; Is ARC file drive in range?
	LD	DE,BADIDR	; No, report bad input drive
	JP	C,PABORT	;  and abort

; Open archive file
	EX	DE,HL		; Recover FCB address
	call	InDU		; set user
	LD	C,$OPEN		; Open ARC file
	CALL	FDOS		; File found?
	JR	NZ,INIT6	; Yes, skip

	LD	HL,ARKFLG	; No, but can we retry with alternate
	OR	(HL)		;  default file type?
	LD	DE,OPNERR	; No, report error
	JR	Z,INIT5		;  and abort (via branch aid)

	LD	(HL),0		; Clear retry flag for next time
	LD	HL,IFCB+@FT+2	; Point to last char of file type
	LD	(HL),'C'	; Change from .ARK to .ARC
	JR	INIT4		; Go attempt open one more time

INIT6:	LD	(IFLAG),A	; Set input file open flag
	LD	DE,ARCMSG	; Show ARC file message
	call	print
	ld	de,arcnam	; show ARC filename
	call	printl
	LD	A,(BLKSZ)	; Get default disk block size
	OR	A		; Explicit default?
	CALL	Z,WHLCK		; Or non-wheel if none? (i.e. forces 1K)
	JR	NZ,SAVBLS	; Yes, skip

; Get current disk's allocation block size for listing
GETBLS:	LD	A,(DBLSZ)	; Any default disk block size?
	OR	A		; (e.g. if $GETDPB not supported)
	JR	NZ,SAVBLS	; Yes, bypass the $GETDPB call

	LD	C,$GETDPB	; Get DPB address
	CALL	BDOS
	INC	HL		; Point to block mask
	INC	HL
	INC	HL
	LD	A,(HL)		; Fetch block mask
	INC	A		; Compute block size / 1K bytes
	RRCA
	RRCA
	RRCA
SAVBLS:	LD	(LBLKSZ),A	; Save block size for listing
	RET			; Return

; Display program usage help message
HELP:	CALL	WHLCK		; Check wheel byte
	PUSH	AF		; Save it
	DEC	A		; Privileged user?
	JR	Z,HELP1		; No, skip (extraction never allowed)

	LD	A,(HODRV)	; File extraction allowed?
	OR	A
HELP1:	LD	HL,USE1		; Setup to clear out usage examples
	LD	BC,256*USE1L+80H
	CALL	Z,FILL		; Do it if not allowed
	LD	HL,USE3
	LD	B,USE3L
	CALL	Z,FILL		; (Two places)
	POP	AF		; Was wheel byte set?
	JR	Z,HELP2		; Yes, skip (typeout etc always allowed)

	LD	HL,USE4		; Clear out print/check option examples
	LD	B,USE4L
	CALL	FILL
	LD	HL,USE5		; (Two places)
	LD	B,USE5L
	CALL	FILL
	LD	A,(TYFLG)	; File typeout allowed?
	OR	A
	LD	HL,USE2
	LD	B,USE2L
	CALL	Z,FILL		; No, clear out usage example
HELP2:	LD	DE,USAGE	; Just print usage message
	JP	PEXIT		;  and exit

; Check wheel byte
WHLCK:	PUSH	HL		; Save register
	LD	HL,(WHEEL)	; Get wheel byte address
	LD	A,(HL)		; Fetch wheel byte
	POP	HL		; Restore reg
	OR	A		; Check wheel byte
	JR	NZ,WHLCK1

	INC	A		; If zero, user is not privileged
	RET			; Return A=1 (NZ)

WHLCK1:	XOR	A		; If non-zero, he's a big wheel
	RET			; Return A=0 (Z)

; Close input and output files (called at program exit)
ICLOSE:	LD	DE,IFCB		; Setup ARC file FCB
	call	InDU		; set user
	LD	A,0		; Get input open flag
IFLAG	EQU	$-1		; (stored here)
	CALL	CLOSE		; Close input file first (e.g. for MP/M)

; Close output file
OCLOSE:	LD	DE,OFCB		; Setup output file FCB
	call	OutDU		; set user
	LD	A,0		; Get output open flag
OFLAG	EQU	$-1		; (stored here)

; Close a file if open
CLOSE:	OR	A		; File is open?
	LD	C,$CLOSE	; Yes, close it
	CALL	NZ,BDOS
	INC	A		; Check return code
	RET			; Return to caller (Z set if error)

; BDOS file functions for output file
OFDOS:	call	OutDU		; set user
	LD	DE,OFCB		; Setup output file FCB

; BDOS file functions
FDOS:	CALL	BDOS		; Perform function
	INC	A		; Test directory code
	RET			; Return (Z set if file not found)

; Set DMA address for file input/output
SETDMA:	LD	C,$SETDMA	; DMA address in DE
	CALL	BDOS		; This is always a good place to...

; Check for CTRL-C abort (and/or read console char if any)
CABORT:	LD	C,$CONST	; Get console status
	CALL	BDOS
	OR	A		; Character ready?
	RET	Z		; Return (Z set) if not

	LD	C,$CONIN	; Input console char (echo if printable)
	CALL	BDOS

; Added to handle any ^S input which is not detected by BDOS
	AND	7FH		; Mask to 7 bits
	CP	CTLS		; Is it CTRL-S (suspend output)?
	LD	C,$CONIN
	CALL	Z,BDOS		; Yes, wait for another char
	AND	7FH		; Mask to 7 bits
	CP	CTLC		; Is it CTRL-C?
	JR	Z,GABORT	; Yes, go abort

	CP	CTLK		; Or is it CTRL-K (RCP/M alternate ^C)?
	RET	NZ		; No, return char (and NZ) to caller

GABORT:	JP	ABORT		; Go abort program

; Archive File Input Routines
;
; Get counted byte from archive subfile (saves alternate register set) --
; The alternate register set normally contains values for the low-level
; output routines (see PUTSET).  This entry to GETC saves these and returns
; with them enstated (for PUT, PUTUP, etc.).  Caller must issue EXX after
; call to return these to the alternate set, and must save and restore any
; needed values from the original register set.  Note: At first glance, all
; this might seem unnecessary, since BDOS (might be called by GETREC) does
; not use the Z80 alternate register set (at least with Digital Research
; CP/M).  But some CBIOS implementations (e.g. Osborne's) assume these are
; fair game, so we are extra cautious here.

GETCX:	EXX			; Swap in alt regs (GETC saves them)

; Get counted byte from component file of archive -- GETC returns with
; carry set (and a zero byte) upon reaching the logical end of the current
; subfile.  (This relies on the GET routine NOT returning with carry set.)

GETC:	PUSH	BC		; Save registers
	PUSH	DE
	PUSH	HL
	LD	HL,SIZE		; Point to remaining bytes in subfile
	LD	B,4		; Setup for long (4-byte) size
GETC1:	LD	A,(HL)		; Get size
	DEC	(HL)		; Count it down
	OR	A		; But was it zero? (clears carry)
	JR	NZ,GET1		; No, go get byte (must not set carry!)

	INC	HL		; Point to next byte of size
	DJNZ	GETC1		; Loop for multi-precision decrement

	LD	B,4		; Size was zero, now it's -1
GETC2:	DEC	HL		; Reset size to zero...
	LD	(HL),A		; (SIZE must contain valid bytes to skip
	DJNZ	GETC2		;  to get to next subfile in archive)

	SCF			; Set carry to indicate end of subfile
	JR	GET2		; Go restore registers and return zero

; Get next sequential byte from archive file -- Note: GET and SEEK rely on
; the fact that the default DMA buffer used for file input (DBUF) begins on a
; half-page boundary.  I.e. DBUF address = nn80H (nn = 00 for standard CP/M).

GET:	PUSH	BC		; Save registers
	PUSH	DE
	PUSH	HL
GET1:	LD	HL,(GETPTR)	; Point to last byte read
	INC	L		; At end of buffer?
	CALL	Z,GETNXT	; Yes, read next record and reset ptr
	LD	(GETPTR),HL	; Save new buffer ptr
	LD	A,(HL)		; Fetch byte from there
GET2:	POP	HL		; Restore registers
	POP	DE
	POP	BC
	RET			; Return

; Get next sequential record from archive file
GETNXT:	LD	C,$READ		; Setup read-sequential function code

; Get record (sequential or random) from archive file
GETREC:	LD	DE,DBUF		; Point to default buffer
	PUSH	DE		; Save ptr
	PUSH	BC		; Save read function code
	CALL	SETDMA		; Set DMA address
	call	InDU		; set user
	LD	DE,IFCB		; Setup FCB address
	POP	BC		; Restore read function
	CALL	BDOS		; Do it
	POP	HL		; Restore buffer ptr
	OR	A		; End of file?
	RET	Z		; Return if not

; Unexpected end of file
EOF:	LD	DE,FMTERR	; Print bad format message and abort
	JP	PABORT		; (not much else we can do)

; Count bytes skipped while processing bad archive header
BADCNT:	INC	HL		; Bump bad byte count
	LD	A,H		; But 64K bytes is enough!
	OR	L
	RET	NZ		; Return if not reached limit

	JR	EOF		; Else, report bad format and abort

; Seek to new random position in file (relative to current position)
; (BCDE = 32-bit byte offset)

SEEK:	LD	A,B		; Most CP/M (2.2) can handle is 23 bits
	OR	A		; So highest bits of offset must be 0
	JR	NZ,EOF		; Else, that's certainly past eof!

	LD	A,E		; Get low bits of offset in A
	LD	L,D		; Get middle bits in HL
	LD	H,C
	ADD	A,A		; LSB of record offset -> carry
	ADC	HL,HL		; Record offset -> HL
	JR	C,EOF		; If too big, report unexpected eof

	RRA			; Get byte offset
	EX	DE,HL		; Save record offset
	LD	HL,GETPTR	; Point to offset (+80H) of last byte in
	ADD	A,(HL)		; Add byte offsets
	LD	(HL),A		; Update buffer ptr for new position
	INC	A		; But does it overflow current record?
	JP	P,SEEK1		; Yes, skip

	LD	A,D		; Check record offset
	OR	E
	RET	Z		; Return if none (still in same record)

	DEC	DE		; Get offset from next record
	JR	SEEK2		; Go compute new record no.

SEEK1:	ADD	A,7FH		; Get proper byte offset in DMA page
	LD	(HL),A		; Save new buffer pointer
SEEK2:	PUSH	DE		; Save record offset
	LD	DE,IFCB
	LD	C,$RECORD	; Compute current "random" record no.
	call	InDU		; set user
	CALL	BDOS		; (I.e. next sequential record to read)
	LD	HL,(IFCB+@RN)	; Get result
	POP	DE		; Restore record offset
	ADD	HL,DE		; Compute new record no.
	JR	C,EOF		; If >64k, it's past largest (8 Mb) file

	LD	(IFCB+@RN),HL	; Save new record no.
	LD	C,$READR	; Read the random record
	CALL	GETREC
	LD	HL,IFCB+@CR	; Point to current record in extent
	INC	(HL)		; Bump for subsequent sequential read
	RET			; Return

; Get archive file header
GETHDR:	LD	DE,HDRBUF	; Set to fill header buffer
	LD	B,HDRSIZ	; Setup normal header size
	CP	1		; But test if version 1
	PUSH	AF		; Save test result
	JR	NZ,GETHD2	; Skip if not version 1

	LD	B,HDRSIZ-4	; Else, header is 4 bytes less
	JR	GETHD2		; Go to store loop

GETHD1:	CALL	GET		; Get header byte
GETHD2:	LD	(DE),A		; Store in buffer
	INC	DE
	DJNZ	GETHD1		; Loop for all bytes

	POP	AF		; Version 1?
	RET	NZ		; No, all done

	LD	HL,SIZE		; Yes, point to compressed size
	LD	C,4		; It's 4 bytes
	LDIR			; Move to uncompressed length
	RET			; Return

; Get, save, and test file name from archive header
GETNAM:	LD	DE,NAME		; Point to name in header
	LD	HL,OFCB+@FN	; Point to output file name
	LD	IX,TNAME	; Point to test pattern
	LD	B,11		; Set count for name and type
GETN1:	LD	A,(DE)		; Get next name char
	AND	7FH		; Ensure no flags, is it end of name?
	JR	Z,GETN4		; Yes, go store blank

	INC	DE		; Bump name ptr
	CP	' '+1		; Is it legal char for file name?
	JR	C,GETN2		; No, if blank or non-printing,
	CP	DEL		;  or this
	JR	NZ,GETN3	; Skip if ok

GETN2:	LD	A,'$'		; Else, change to something legal
GETN3:	CALL	UPCASE		; Ensure it's upper case
	CP	'.'		; But is it type separator?
	JR	NZ,GETN5	; No, go store name char

	LD	A,B		; Get count of chars left
	CP	4		; Reached type yet?
	JR	C,GETN1		; Yes, bypass the separator

	DEC	DE		; Backup to re-read separator
GETN4:	LD	A,' '		; Set to store a blank
GETN5:	LD	(HL),A		; Store char in output name
	LD	A,(IX)		; Get pattern char
	INC	IX		; Bump pattern ptr
	CP	'?'		; Pattern matches any char?
	JR	Z,GETN6		; Yes, skip

	CP	(HL)		; Matches this char?
	RET	NZ		; Return (NZ) if not

GETN6:	INC	HL		; Bump store ptr
	DJNZ	GETN1		; Loop until FCB name filled

	LD	BC,256*(@FCBSZ-@FN-11)+0
	JP	FILL		; Zero rest of FCB, return (Z still set)

; File Output Routines
;
; Check output drive and setup for file output

OUTSET:	LD	A,(HODRV)	; Get highest allowed output drive
	LD	B,A		; Save for later test
	LD	HL,CHECKF	; Point to check-only flag
	CALL	WHLCK		; Check wheel byte
	DEC	A		; Is user privileged?
	JR	NZ,OUTS1	; Yes, skip

	LD	B,A		; Else, no output drive allowed
	LD	(HL),A		; No checking allowed
	LD	(PROUTF),A	; No printing allowed
	LD	A,(TYFLG)	; Fetch flag for typeout allowed
OUTS1:	LD	C,A		; Save typeout flag (always if wheel)
	ld	a,(HOUsr)	; get high output user
	inc	a		; make it one higher
	ld	d,a		; save it
	ld	a,(OutUsr)	; get max output user
	cp	d
	jr	nc,Outs3	; (user too high)
	LD	A,(OFCB)	; Any output drive?
	OR	A
	JR	NZ,OUTS2	; Yes, skip to check it

	OR	(HL)		; Just checking files?
	JR	Z,CKTYP		; No, go see if typeout permitted

	LD	DE,CHKMSG	; Yes, show 'Checking...' message
	CALL	PRINTL
	LD	A,0FEH		; Set dummy drive in output FCB
	LD	(OFCB),A
	JR	CRCINI		; Skip to init CRC computations

OUTS2:	DEC	A		; Get zero-relative drive no.
	CP	B		; In range of allowed drives?
Outs3:	LD	DE,BADODR	; No, report bad output directory
	JP	NC,PABORT	;  and abort

	LD	E,A		; Save output drive
	PUSH	DE
	ADD	A,'A'		; Convert to ASCII
	LD	(OUTDRV),A	; Store drive letter for message
	LD	DE,OUTMSG	; Show output drive
	CALL	PRINTL
	LD	C,$DISK		; Get default drive
	CALL	BDOS
	POP	DE		; Recover output drive
	CP	E		; Test if same as default
	PUSH	AF		; Save default drive (and test result)
	LD	C,$SELECT	; Select output drive
	CALL	NZ,BDOS		;  (if different than default)
	CALL	GETBLS		; Get its block size for listing
	POP	AF		; Restore original default drive
	LD	E,A
	LD	C,$SELECT	; Reselect it
	CALL	NZ,BDOS		;  (if changed)

; Initialize lookup table for CRC generation -- Note: For maximum speed,
; the CRC routines rely on the fact that the lookup table (CRCTAB) is
; page-aligned.

X16	EQU	0		; x^16 (implied)
X15	EQU	1 SHL (15-15)	; x^15
X2	EQU	1 SHL (15-2)	; x^2
X0	EQU	1 SHL (15-0)	; x^0 = 1
POLY	EQU	X16+X15+X2+X0	; Polynomial (CRC-16)

CRCINI:	LD	HL,CRCTAB+256	; Point to 2nd page of lookup table
	LD	A,H		; Check enough memory to store it
	CALL	CKMEM
	LD	DE,POLY		; Setup polynomial

; Loop to compute CRC for each possible byte value from 0 to 255
CRCIN1:	LD	A,L		; Init low CRC byte to table index
	LD	BC,256*8	; Setup bit count, clear high CRC byte

; Loop to include each bit of byte in CRC
CRCIN2:	SRL	C		; Shift CRC right 1 bit (high byte)
	RRA			; (low byte)
	JR	NC,CRCIN3	; Skip if 0 shifted out

	EX	AF,AF'		; Save lower CRC byte
	LD	A,C		; Update upper CRC byte
	XOR	D		;  with upper polynomial byte
	LD	C,A
	EX	AF,AF'		; Recover lower CRC byte
	XOR	E		; Update with lower polynomial byte
CRCIN3:	DJNZ	CRCIN2		; Loop for 8 bits

	LD	(HL),C		; Store upper CRC byte (2nd table page)
	DEC	H
	LD	(HL),A		; Store lower CRC byte (1st table page)
	INC	H
	INC	L		; Bump table index
	JR	NZ,CRCIN1	; Loop for 256 table entries

	RET

; Check for valid file name for typeout (or printing)
CKTYP:	OR	C		; Typeout not allowed?
	CALL	NZ,TAMBIG	; Or ambiguous output file name?
	RET	Z		; Yes, return (will just list file)

	LD	DE,NOTYP	; Point to table of excluded types
CKTYP1:	LD	HL,TNAME+8	; Point to type of selected file
	LD	B,3		; Setup count for 3 chars
CKTYP2:	LD	A,(DE)		; Fetch next table char
	OR	A		; End of table?
	JR	Z,CKTYP5	; Yes, go set flag to allow typeout

	CP	'?'		; Matches any char?
	JR	Z,CKTYP3	; Yes, skip

	CP	(HL)		; Matches this char?
CKTYP3:	INC	DE		; Bump table ptr
	JR	Z,CKTYP4	; Matched?
	DJNZ	CKTYP3		; No, just advance to next table entry
	JR	CKTYP1		; Then loop to try again

CKTYP4:	INC	HL		; Char matched, point to next
	DJNZ	CKTYP2		; Loop for all chars in file type
	RET			; If all matched, return (no typeout)

CKTYP5:	DEC	A		; If no match, file name is valid
	LD	(OFCB),A	; Set dummy drive (0FFH) in output FCB
	RET			; Return

; Test for ambiguous output file selection
TAMBIG:	LD	HL,TNAME	; Point to test pattern

; Check for ambiguous file name (HL = ptr to FCB-type name)
FAMBIG:	LD	BC,11		; Setup count for file name and type
	LD	A,'?'		; Any "?" chars?
	CPIR			; Yes, return with Z set
	RET			; No, return NZ

; Extract file for disk or console output
OUTPUT:	LD	A,(OFCB)	; Any output drive (or typing files)?
	OR	A
	RET	Z		; No, there's nothing to do here

	LD	B,A		; Save output drive
	LD	A,(VER)		; Get header version
	CP	ARCVER+1	; Supported for output?
	LD	DE,BADVER	; No, report unknown version
	JP	NC,PABORT	;  and abort

	LD	L,A		; Copy version
	LD	H,0
	LD	DE,OBUFT-1	; Use to index table of starting
	ADD	HL,DE		;  output buffer pages
	LD	A,(HL)		; Get starting page of buffer
	CALL	CKMEM		; Ensure enough memory
	LD	HL,BUFPAG	; Point to buffer start page
	LD	(HL),A		; Save it
	LD	C,A		; (also for typeout buffer check)
	INC	HL		; Point to buffer limit (BUFLIM)
	LD	A,(HIPAGE)	; Get memory limit page
	LD	(HL),A		; Assume max possible output buffer
	INC	B		; Typing files?
	JR	NZ,OUTDSK	; No, go extract to disk

; Setup for console (or printer) output
	LD	A,(TYPGS)	; Get max. pages to buffer typeout
	OR	A		; No limit?
	CALL	Z,WHLCK		; And is this privileged user?
	JR	Z,OUTCON	; Yes, skip (use 1 page if no privilege)

	ADD	A,C		; Compute desired limit page
	JR	C,OUTCON	; But skip if exceeds (physical) memory
	CP	(HL)
	JR	NC,OUTCON	; Also if exceeds available memory

	LD	(HL),A		; If ok, set lower buffer limit
OUTCON:	LD	A,(PROUTF)	; Printing file?
	OR	A
	JR	NZ,OUTBEG	; Yes, skip the separator

	LD	HL,LINE		; Fill listing line with dashes
	LD	BC,256*LINLEN+'-'
	CALL	FILL
	CALL	LISTL		; Print separating line first
	JR	OUTBEG		; Go extract file for typeout

; Setup for disk file (or black hole) output
OUTDSK:	INC	B		; Just checking file?
	JR	Z,OUTBEG	; Yes, skip

	LD	DE,BUFF		; Set DMA address to a safe place
	CALL	SETDMA
	LD	C,$FIND		; Find file
	CALL	OFDOS		; Already exists?
	JR	Z,OUTD2		; No, skip

	LD	DE,EXISTS	; Inform user and ask:
	CALL	PRINTS		; Should we overwrite existing file?
OUTD1:	CALL	CABORT		; Wait for response (or CTRL-C abort)
	JR	Z,OUTD1

	LD	E,A		; Save response
	CALL	CRLF		; Start a new line after prompt
	LD	A,E		; Get response char
	CALL	UPCASE		; Upper and lower case are the same
	CP	'Y'		; Answer was yes?
	RET	NZ		; No, return (skip file output)

	LD	C,$DELETE	; Yes, delete existing file
	CALL	OFDOS
OUTD2:	LD	C,$MAKE		; Create a new file
	CALL	OFDOS		; But directory full?
	LD	DE,DIRFUL	; Yes, report error
	JP	Z,PABORT	;  and abort

	LD	(OFLAG),A	; Set flag for output file open

; All set to output file
OUTBEG:	LD	A,(VER)		; Check compression type
	CP	4
	JR	NC,USQ		; Skip if squeezed or crunched/squashed

	CALL	PUTSET		; Else (simple cases), setup output regs
	CP	3		; Packed?
	JR	Z,UPK		; Yes, skip

; Uncompressed file
UNC:	CALL	GETC		; Just copy input to output
	JR	C,OUTEND	;  until end of file
	CALL	PUT
	JR	UNC

; Packed file
UPK1:	CALL	PUTUP		; Output with repeated byte expansion
UPK:	CALL	GETC		; Get input byte
	JR	NC,UPK1		; Loop until end of file

; End of output file
OUTEND:	CALL	PUTBUF		; Flush final buffer (if any)
	LD	A,(OFCB)	; Typing (or printing) file?
	INC	A
	RET	Z		; Yes, all done (no CRC check)

; Added because the preceding test no longer clears carry.
	OR	A		; Clear carry for 16-bit subtract
	EX	DE,HL		; Save computed CRC
	LD	HL,(CRC)	; Get CRC recorded in archive header
	SBC	HL,DE		; Do they match?
	LD	DE,CRCERR	; If not,
	CALL	NZ,OWARN	;  print warning message
	LD	HL,LEN		; Point to remaining (output) length
	CALL	LGET		; Fetch length (it's 4 bytes)
	LD	A,B		; All should be zero...
	OR	C
	OR	D
	OR	E
	LD	DE,LENERR	; If not,
	CALL	NZ,OWARN	;  print incorrect length warning
	CALL	OCLOSE		; Close output file (if open)
	LD	HL,OFLAG	; Clear file open flag
	LD	(HL),0
	RET	NZ		; Return unless error closing file

	LD	DE,CLSERR	; Else, report close failure
	JP	PABORT		;  and abort

; Unsqueeze (Huffman-coded) file -- we take a KISS approach which assumes
; the tree is valid and relies upon the final output file CRC and length
; checks to warn of any possible errors: (1) the tree is initially cleared
; (all links point to the root node); (2) at most 256 nodes are stored; and
; (3) decoding terminates upon detecting the special end-of-file code in the
; data (the normal case), the physical end-of-file (as determined by the
; size recorded in the archive header), or a tree link to the root node
; (which indicates a diseased tree).

; Start unsqueezing
USQ:	JR	NZ,UCR		; But skip if crunched/squashed file

; First clear the decoding tree
	LD	BC,TREESZ-1	; Setup bytes to clear - 1
	CALL	TREECL		; (Leaves DE pointing past end of tree)

; Read in the tree -- Note: The end-of-file condition may be safely ignored
; while reading the node count and tree, since GETC will repeatedly return
; zero bytes in this case.

	CALL	GETC		; Get node count, low byte
	LD	C,A		; Save for loop
	CALL	GETC		; Get high byte (can be ignored)
	OR	C		; But is it zero nodes?
	JR	Z,USQ3		; Yes (very unlikely), it's empty file

USQ1:	LD	B,4		; Setup count for 4 bytes in node
	LD	A,D		; Each byte will be stored in a separate
	SUB	B		;  page (tree is page-aligned), so
	LD	D,A		;  point back to the first page
USQ2:	CALL	GETC		; Get next byte
	LD	(DE),A		; Store in tree
	INC	D		; Point to next page
	DJNZ	USQ2		; Loop for all bytes in node

	INC	E		; Bump tree index
	DEC	C		; Reduce node count
	JR	NZ,USQ1		; Loop for all nodes

USQ3:	CALL	PUTSET		; Done with tree, setup output regs
	PUSH	HL		; Reset current input byte (on stack)

; Start of decoding loop for next output byte
USQ4:	EXX			; Save output registers
	XOR	A		; Reset node index to root of tree

; Top of loop for next input bit
USQ5:	LD	L,A		; Setup index of next tree node
	POP	AF		; Get current input byte
	SRL	A		; Shift out next input bit
	JR	NZ,USQ6		; Skip unless need a new byte

; Read next input byte
	PUSH	HL		; Save tree index
	CALL	GETCX		; Get next input byte
	EXX			; Save output regs
	JR	C,USQEND	; But go stop if reached end of input

	POP	HL		; Restore tree index
	SCF			; Set flag for end-of-byte detection
	RRA			; Shift out first bit of new byte

; Process next input bit
USQ6:	PUSH	AF		; Save input byte
	LD	H,HIGH TREE	; Point to start of current node
	JR	NC,USQ7		; Skip if new bit is 0

	INC	H		; Bit is 1, point to 2nd word of node
	INC	H		; (3rd tree page)
USQ7:	LD	A,(HL)		; Get low byte of node word
	INC	H
	LD	B,(HL)		; Get high byte (from next tree page)
	INC	B
	JR	NZ,USQ8		; Skip if high byte not -1

	CPL			; We've got output byte (complemented)
	EXX			; Restore regs for output
	CALL	PUTUP		; Output with repeated byte expansion
	JR	USQ4		; Loop for next byte

USQ8:	DJNZ	USQEND		; If high byte not 0, it's special EOF
	OR	A		; If high byte was 0, its new node link
	JR	NZ,USQ5		; Loop for new node (but can't be root)

; End of squeezed file (physical, logical, or due to Dutch elm disease)
USQEND:	POP	HL		; Cleanup stack

; End of unsqueezed or uncrunched file output
UCREND:	EXX			; Restore output regs
	JP	OUTEND		; Go end output

; Clear squeezed file decoding tree (or crunched file string table)
TREECL:	LD	HL,TREE		; Point to tree (also string table)
STRTCL:				; (Entry for partial string table clear)
	LD	(HL),L		; Clear first byte (it's page-aligned)
	LD	D,H		; Copy pointer to first byte
	LD	E,L
	INC	DE		; Propogate it thru second byte, etc.
	LDIR			; (called with BC = byte count - 1)
	RET			; Return

; Uncrunch (LZW-coded) file -- LZW is a one-pass procedure which encodes
; variable-length strings of bytes by a fixed-length code (12 bits in this
; implementation), without additional overhead in the output file.  In
; essence, the procedure adapts itself dynamically to the redundancy present
; in the input data.  LZW requires substantially more memory than Huffman
; coding and decoding.  A 12K-byte string table is required in this program.
; The MS-DOS ARC program uses even more.  The MS-DOS ARC program has employed
; for different variations differentiated by the version byte in the archive
; file header:
;	Version 5:  LZW applied to original input file
;	Version 6:  LZW applied to file after packing repeated bytes
;	Version 7:  Same as version 6 with a new (faster) hash code
;	Version 8:  Completely new (much improved) implementation
; The MS-DOS program PKARC 2.0 introduced another variation ("squashing"):
;	Version 9:  Same as version 8 with 13-bit codes and no pre-packing
; Version 8 (and 9) varies the output code width from 9 to 12 (13) bits as
; the string table grows (benefits small files), performs an adaptive reset
; of the string table after it becomes full if the compression ratio drops
; (benefits large files), and eliminates the need for hash computations by
; the decoder (reduces decoding time and space; in this program, an extra
; 8K-byte table is eliminated).  Although the latest release of the ARC
; program uses only this last version for encoding, we support all four
; (five) versions for compatibility with files encoded by earlier releases.

; Setup for uncrunching (or unsquashing) -- We've been able to isolate all
; of the differences between the five versions of LZW into just three
; routines -- input, output, and hash function.  These are disposed of
; first, by inserting appropriate vectors into common coding and initial-
; izing version-dependent data.  Introduction of squashed files added some
; extra kludges here.

UCR:	LD	HL,STRBIT	; All but version 9 use 4K string table
	LD	(HL),BIT4H	;  entries, so setup STRADD bit test
	CP	8		; Version 8 or 9?
	JR	NC,UCR1		; Yes, skip

	LD	DE,OGETCR	; Old versions get fixed 12-bit codes
	LD	BC,STRSZ+HSHSZ-1;  and need extra table for hashing
	LD	HL,OHASH	; Assume old hash function
	CP	6		; Test version
	LD	A,55H		; Setup initial flags for OGETCR
	JR	Z,UCR6		; All set if version 6
	JR	C,UCR5		; Skip if version 5

	LD	HL,FHASH	; Version 7 uses faster hash function
	JR	UCR6		; (but we've never seen one of these!)

UCR1:	JR	Z,UCR2		; Skip if version 8
	LD	(HL),BIT5H	; Version 9 allows 13-bit codes
	LD	BC,STQSZ-1	;  and has larger string table
	LD	A,8192/256	;  with 8K entries (less buffer space)
	JR	UCR4		; Join common code for versions 8 and 9

; Note:	This is the only place that we reference the code size for crunched
; files (CRBITS) symbolically.  Currently, a value of 12 bits is required
; and it is assumed throughout the program.
UCR2:	CALL	GETC		; Read code size used to crunch file
	JR	C,UCR3		; But skip if none (PKARC 0-length file)
	CP	CRBITS		; Same as what we expect?
	LD	DE,UCRERR	; No, report incompatible format
	JP	NZ,PABORT	;  and abort

UCR3:	LD	BC,STRSZ-1	; Version 8 provides more buffer space
	LD	A,4096/256	;  and only 4K string table entries
UCR4:	LD	(STRMAX),A	; Setup NHASH table-full test
	LD	HL,0		; Clear code residue and count to init
	LD	(CODES),HL	;  NGETCR input (BITSAV and CODES)
	LD	DE,NGETCR	; New version has variable-length codes
	LD	HL,NHASH	;  and has a very simple "hash"
	LD	A,9		; Setup initial code size for NGETCR
	JR	Z,UCR6		; Skip if version 8

UCR5:	LD	IX,PUT		; Versions 5 and 9 don't unpack
	JR	UCR7

UCR6:	LD	IX,PUTUP	; Versions 6-8 unpack repeated bytes
UCR7:	LD	(PUTCRP),IX	; Save ptr to output routine
	LD	(HASHP),HL	; Save ptr to hash function
	LD	(GETCRP),DE	; Save ptr to input routine
	LD	(BITS),A	; Initialize input routine
	LD	A,B		; Get string table pages to clear (-1)
	SUB	3		; Less 3 for atomic strings
	LD	(STRCSZ),A	; Setup for reset clear in NGETCR

; Start uncrunching (All version-dependent differences are handled now)
	CALL	TREECL		; Clear string (and hash) table(s)
	LD	(STRCT),BC	; Set no entries in string table
	DEC	BC		; Get code for no prefix string (-1)
	PUSH	BC		; Save as first-time flag
	XOR	A		; Init table with one-byte strings...
GCR0:	POP	BC		; Set for no prefix string
	PUSH	BC		; (Resave first-time flag)
	PUSH	AF		; Save byte value
	CALL	STRADD		; Add to table
	POP	AF		; Recover byte
	INC	A		; Done all 256 bytes?
	JR	NZ,GCR0		; No, loop for next

	CALL	PUTSET		; Setup output registers

; Top of loop for next input code (top of stack holds previous code)
GCR:	EXX			; Save output regs first
GETCR:	CALL	0		; Get next input code
GETCRP	EQU	$-2		; (ptr to NGETCR or OGETCR stored here)
	POP	BC		; Recover previous input code (or -1)
	JP	C,UCREND	; But all done if end of input

	PUSH	HL		; Save new code for next loop
	CALL	STRPTR		; Point to string table entry for code
	INC	B		; Is this the first one in file?
	JR	NZ,GCR2		; No, skip

	INC	HL		; Yes,
	LD	A,(HL)		; Get first output byte
GCR1:	CALL	PUTCR		; Output final byte for this code
	JR	GCR		; Loop for next input code

GCR2:	DEC	B		; Correct prev code (stays in BC awhile)
	LD	A,(HL)		; Is new code in table?
	OR	A
	PUSH	AF		; (Save test result for later)
	JR	NZ,GCR3		; Yes, skip

	LD	H,B		; Else (special case), setup previous
	LD	L,C		;  code (it prefixes the new one)
	CALL	STRPTR		; Point to its table entry instead

; At this point, we have the table ptr for the new output string (except
; possibly its final byte, which is a special case to be handled later).
; Unfortunately, the table entries are linked in reverse order; i.e.,
; we are pointing to the last byte to be output.  Therefore, we trace
; through the table to find the first byte of the string, reversing the
; link order as we go.  When done, we can output the string in forward
; order and restore the original link order.

; Careful:  The following value must be non-zero, so that the old-style
; hash (invoked by STRADD below) will not think a re-linked entry is
; unused!
GCR3:	LD	D,1		; Init previous entry ptr (01xxH = none)
GCR4:	LD	A,(HL)		; Test this entry
	CP	HIGH STRT	; Any prefix string?
	JR	C,GCR5		; No, we've reached the first byte

	LD	(HL),D		; Relink this entry
	LD	D,A		; (i.e. swap prev ptr with prefix ptr)
	DEC	HL
	LD	A,(HL)
	LD	(HL),E
	LD	E,A
	INC	HL
	EX	DE,HL		; Swap current ptr with prefix ptr
	JR	GCR4		; Loop for next entry

; HL points to table entry for first byte of output string.  We can now
; add the table entry for the string which the encoder placed in his
; table before sending us the current code.  (It's the previous code's
; string concatenated with the first byte of the new string).  Note that
; BC has been holding the previous code all this time.
GCR5:	INC	HL		; Point to byte
	POP	AF		; Recover special-case flag
	LD	A,(HL)		; Fetch byte
	PUSH	AF		; Re-save flag along with byte
	DEC	HL		; Restore table ptr
	PUSH	DE		; Save ptr to prev entry
	PUSH	HL		; Save ptr to this entry
	CALL	STRADD		; Add new code to table (for BC and A)
	POP	HL		; Setup table ptr for output loop

; Top of string output loop -- HL points to table entry for byte to output.
; Top of stack contains pointer to next table entry (or 01xxH).
GCR6:	INC	HL		; Point to byte
	LD	A,(HL)		; Fetch it
	PUSH	HL		; Save table ptr
	CALL	PUTCR		; Output the byte (finally!)
	EXX			; Save output regs
	POP	DE		; Recover ptr to this byte
	POP	HL		; Recover ptr to next byte's entry
	DEC	H		; Reached end of string?
	JR	Z,GCR7		; Yes, skip out of loop

	INC	H		; Correct next entry ptr from above test
	DEC	DE		; Restore ptr to this entry's mid byte
	LD	A,(HL)		; Relink the next entry
	LD	(HL),D		; (i.e. swap its "prefix" ptr with
	LD	D,A		;  ptr to this entry)
	DEC	HL
	LD	A,(HL)
	LD	(HL),E
	LD	E,A
	INC	HL
	PUSH	DE		; Save ptr to 2nd next entry
	JR	GCR6		; Loop to output next byte

; End of uncrunching loop -- All bytes of new string have been output,
; except possibly the final byte (which is the same as the first byte in
; this special case).
GCR7:	POP	AF		; Recover special-case flag and byte
	JR	NZ,GETCR	; If not set, loop for next input code

	JR	GCR1		; Else, go output final byte first

; Add entry to string table -- This routine receives a 12-bit prefix string
; code in BC and a suffix byte in A.  It then adds an entry to the string
; table (unless it's full) for the new string obtained by concatenating
; these.  Nothing is (or need be) returned to the caller.

; String table format: The table (STRT) contains 4096 three-byte entries,
; each of which is identified by a 12-bit code (table index).  The third
; byte (highest address) of each entry contains the suffix byte for the
; string.  The first two bytes contain a pointer (low-byte first) to the
; middle byte of the table entry for the prefix string.  The null string
; (prefix to the one-byte strings) is represented by a (16-bit) code value
; -1, which yields a non-zero pointer below the base address of the table.
; An empty table entry contains a zero prefix pointer.  Our choice to
; represent prefix strings by pointers rather than codes speeds up almost
; everything we do.  The high byte of the prefix pointer (middle byte of an
; entry) may be tested for non-zero to determine if an entry is occupied,
; and (since the table is page-aligned) it may be further tested against the
; page address of the table's base (HIGH STRT) to decide if it represents
; the null string.  Note that the entry for code 256 is not used in the
; newer version of crunching.  This is reserved for a special signal to
; reset the string table (handled by the hash and input routines, NHASH and
; NGETCR).

STRADD:	LD	HL,(STRCT)	; Get count of strings in table
	BIT	4,H		; Is it the full 4K?

; Note:	Above test complicated by introduction of squashed files (which
; allow 13-bit codes and 8K string table entries) and the non-Z80 emulation
; of the BIT instruction.  Following definitions handle this.

STRBIT	EQU	$-1		; Byte to modify BIT instruction
BIT4H	EQU	64H		; High byte of BIT 4,H
BIT5H	EQU	6CH		; High byte of BIT 5,H
	RET	NZ		; Yes, forget it

	INC	HL		; Bump count for one more
	LD	(STRCT),HL	; Save new string count
	PUSH	AF		; Save suffix byte
	PUSH	BC		; Save prefix code
	CALL	0		; Hash them to get pointer to new entry
HASHP	EQU	$-2		; (ptr to xHASH routine stored here)
	EX	(SP),HL		; Save result, recover prefix code
	CALL	STRPTR		; Get pointer to prefix entry
	EX	DE,HL		; Save it
	POP	HL		; Recover new entry pointer
	DEC	HL		; Point to low byte of entry
	LD	(HL),E		; Store prefix ptr in entry
	INC	HL		;  (low byte first)
	LD	(HL),D		;  (then high byte, in mid entry byte)
	INC	HL		; Point to high byte of new entry
	POP	AF		; Recover suffix byte
	LD	(HL),A		; Store
	RET			; All done

; Hash function for (new-style) crunched files -- Note: "Hash" is of course
; a misnomer here, since strings are simply added to the table sequentially
; with the newer crunch method.  This routine's main responsibility is to
; update the bit-length for expected input codes, and to bypass the table
; entry for code 256 (reserved for adaptive reset), at appropriate times.

NHASH:	LD	A,L		; Copy low byte of string count in HL
	DEC	L		; Get table offset for new entry
	OR	A		; But is count a multiple of 256?
	JR	NZ,STRPTR	; No, just return the table pointer

	LD	A,H		; Copy high byte of count
	DEC	H		; Complete double-register decrement
	LD	DE,STRCT	; Set to bump string count (bypasses
	JR	Z,NHASH1	;  next entry) if exactly 256

	CP	4096/256	; Else, is count the full 4K?
STRMAX	EQU	$-1		; (Byte to modify max string count test)
	JR	Z,STRPTR	; Yes (last table entry), skip

; Note the following cute test.  (It's mentioned in K & R, ex. 2-9.)
	AND	H		; Is count a power-of-two?
	JR	NZ,STRPTR	; No, skip

	LD	DE,BITS		; Yes, next input code is one bit longer

; Note:	By definition, there can be no input code residue at this point.
; I.e. (BITSAV) = 0, since we have read a power-of-two (> 256) no. of codes
; at the old length (total no. of bits divisible by 8).  By the same
; argument, (CODES) = 0 modulo 8 (see NGETCR).
NHASH1:	EX	DE,HL		; Swap in address value to increment
	INC	(HL)		; Bump the value (STRCT or BITS)
	EX	DE,HL		; Recover table offset

; Get pointer to string table entry -- This routine is input a 12-bit code
; in HL (or -1 for the null string).  It returns a pointer in HL to the
; middle byte of the string table entry for that code (STRT-2 for the null
; string).  Destroys DE only.
STRPTR:	LD	D,H		; Copy code
	LD	E,L
	ADD	HL,HL		; Get 2 * code
	ADD	HL,DE		; Get 3 * code
	LD	DE,STRT+1	; Point to table base entry (2nd byte)
	ADD	HL,DE		; Compute pointer
	RET			; Return

; Get variable-length code from (new-style) crunched file -- These codes are
; packed in right-to-left order (lsb first).  The code length (stored in
; BITS) begins at 9 bits and increases up to a maximum of 12 bits (13 bits
; for squashed files) as the string table grows (maintained by NHASH).
; Location BITSAV holds residue bits remaining in the last input byte after
; each call (must be initialized to 0, code assumes BITSAV = BITS-1).  In
; comparison, the MS-DOS ARC program buffers 8 codes at a time (i.e. n bytes,
; where n = bits/code) and flushes this buffer whenever the code length
; changes (so that first code at new length begins on an even byte boundary).
; By coincidence (see NHASH) this buffer is always empty when the code length
; increases as a result of normal string table growth.  Thus the only time
; this added bufferring affects us is when the code length is reset back to
; 9 bits upon receipt of the special clear request (code 256), at which time
; we must possibly bypass up to 10 input bytes (worst case = 7 codes at 1.5
; bytes/code).  This is handled by a simple down-counter in location CODES,
; whose mod-8 value indicates the no. of codes which should be skipped (must
; be initialized to 0, code assumes that CODES = BITSAV-1).  Note: This can
; probably be made a lot faster (e.g. by unfolding into 8 separate cases and
; using a co-routine return), but that's a lot of work.  For now, we KISS
; ("keep it short and simple").

NGETCR:	LD	HL,CODES	; First update code counter
	DEC	(HL)		;  for clear code processing
	INC	HL		; Point to BITSAV
	LD	A,(HL)		; Get saved residue bits
	INC	HL		; Point to BITS
	LD	B,(HL)		; Setup bit counter for new code
	LD	HL,7FFFH	; Init code (msb reset for end detect)

; Top of loop for next input bit
NGETC1:	SRL	A		; Shift out next input bit
	JR	Z,NGETC7	; But skip out if new byte needed

NGETC2:	RR	H		; Shift bit into high end of code word
	RR	L		;  (double-register shift)
	DJNZ	NGETC1		; Loop until have all bits needed

; Input complete, cleanup code word
NGETC3:	SRL	H		; Shift code down,
	RR	L		;  to right-justify it in HL
	JR	C,NGETC3	; Loop until end flag shifted out

	LD	(BITSAV),A	; Save input residue for next call
	LD	A,H		; But is it code 256?
	DEC	A		; (i.e. adaptive reset request)
	OR	L
	RET	NZ		; No, return (carry clear)

; Special handling to reset string table upon receipt of clear code
	LD	HL,BITS		; Point to BITS
	LD	C,(HL)		; Fetch current code length
	LD	(HL),9		; Go back to 9-bit codes
	DEC	HL		; Point to BITSAV
	LD	(HL),A		; Empty the residue buffer
	DEC	HL		; Point to CODES
	LD	A,(HL)		; Get code counter
	AND	7		; Modulo 8 is no. codes to flush
	JR	Z,NGETC6	; Skip if none

; In early versions coding was simplified by the (incorrect) assumption that
; 12-bit codes are being generated at this point.  While true for .ARC files
; created by ARC 5.12 or earlier, this is not necessarily the case for files
; created by PKARC 1.1 or later.  Hence, some added effort here now...
	LD	B,A		; Save no. codes to flush
	XOR	A		; Reset no. bits to flush
	LD	(HL),A		; Reset code counter to 0 for next time
NGETC4:	ADD	A,C		; Add no. bits per code
	DJNZ	NGETC4		; Loop to compute total bits to flush

	RRA			; Divide by 8
	RRA
	RRA
	AND	0FH		; Max possible result 10 (11 squashed)
	LD	B,A		; Obtain no. input bytes to bypass
NGETC5:	PUSH	BC		; Loop to flush the (encoder's) buffer
	CALL	GETCX
	EXX			; (No need to test for end-of-file
	POP	BC		;  here, we'll pick it up later if
	DJNZ	NGETC5		;  it happens)

NGETC6:	LD	HL,STRT+(3*256)	; Clear out (all but one-byte) strings
	LD	BC,STRSZ-(3*256)-1
STRCSZ	EQU	$-1		; (Byte to modify string tbl clear size)
	CALL	STRTCL
	LD	HL,257		; Reset count for just one-byte strings
	LD	(STRCT),HL	;  plus the unused entry

; Kludge: We rely here on the fact that the previous input code is at top of
; caller's stack, where -1 indicates none.  This should properly be done by
; the caller, but doing it here preserves commonality of coding for old-
; style crunched files (i.e. caller never knows this happened).
	POP	HL		; Get return address
	EX	(SP),HL		; Exchange with top of (caller's) stack
	LD	HL,-1		; Set no previous code
	EX	(SP),HL		; Replace on stack
	PUSH	HL		; Restore return
	JR	NGETCR		; Go again for next input code

; Read next input byte
NGETC7:	PUSH	BC		; Save bit count
	PUSH	HL		; Save partial code
	CALL	GETCX		; Get next input byte
	EXX			; Save output regs
	POP	HL		; Restore code
	POP	BC		; Restore count
	RET	C		; But stop if reached end of file

; Special test to speed things up a bit...(If need the whole byte, might as
; well save some bit fiddling)
	BIT	3,B		; At least 8 more bits needed?
	JR	NZ,NGETC8	; Yes, go do it faster

	SCF			; Else, set flag for end-of-byte detect
	RRA			; Shift out first bit of new byte
	JR	NGETC2		; Go back to bit-shifting loop

; Update code by (entire) new byte
NGETC8:	LD	L,H		; Shift code down 8 bits
	LD	H,A		; Insert new byte into code
	LD	A,B		; Get bit count
	SUB	8		; Reduce by 8
	LD	B,A		; Update remaining count
	JR	NZ,NGETC7	; Get another byte if still more needed

	JR	NGETC3		; Else, go exit early (note A=0)

; Hash functions for (old-style) crunched files -- This stuff exists for the
; sole purpose of processing files which were created by older releases of
; MS-DOS ARC (pre-version 5.0).  The multiplications required by the two
; hash function versions are sufficiently specialized that we've hand-coded
; each of them separately, for speed, rather than use a common multiply
; subroutine.

; Versions 5 and 6...Compute hash key = upper 12 of lower 18 bits of
; unsigned square of: (prefix code + suffix byte) OR 800H.
OHASH:	LD	DE,0		; Clear product
	LD	L,A		; Extend suffix byte
	LD	H,D		;  to 16 bits
	ADD	HL,BC		; Sum with prefix code
	SET	3,H		; Or in 800H

; We now have a 13-bit number which is to be squared, but we are only
; interested in the lower 18 bits of the 26-bit product.  The following
; reduces this to a 12-bit multiply which yields the correct product shifted
; right 2 bits.  This is acceptable (we discard the low 6 bits anyway) and
; allows us to compute desired result in a 16-bit register.  For the
; algebraically inclined...
;   If n is even (n = 2m + 0):  n * n = 4(m * m)
;   If n is odd  (n = 2m + 1):  n * n = 4(m * (m+1)) + 1
	SRA	H		; Divide number by 2 (i.e. "m")
	RR	L		; HL will be multiplicand (m or m+1)
	LD	C,H		; Copy to multiplier in C (high byte)
	LD	A,L		;  and A (low byte)
	ADC	HL,DE		; If was odd, add 1 to multiplicand

; Note there is one anomalous case:  The first one-byte string (with
; prefix = -1 = 0FFFFH and suffix = 0) generates the 16-bit sum 0FFFFH,
; which should hash to 800H (not 0).  The following test handles this.
	JR	C,OHASH3	; Skip if special case (will get 800H)
	LD	B,12		; Setup count for 12 bits in multiplier

; Top of multiply loop (vanilla shift-and-add)
OHASH1:	SRL	C		; Shift out next multiplier bit
	RRA
	JR	NC,OHASH2	; Skip if 0

	EX	DE,HL		; Else, swap in product
	ADD	HL,DE		; Add multiplicand (carries ignored)
	EX	DE,HL		; Reswap
OHASH2:	ADD	HL,HL		; Shift multiplicand
	DJNZ	OHASH1		; Loop until done all multiplier bits

; Now have the desired hash key in upper 12 bits of the 16-bit product
	EX	DE,HL		; Obtain product in HL
	ADD	HL,HL		; Shift high bit into carry
OHASH3:	RLA			; Shift up 4 bits into A...
	ADD	HL,HL
	RLA
	ADD	HL,HL
	RLA
	ADD	HL,HL
	RLA
	LD	L,H		; Move down low 8 bits of final result
	JR	HASH		; Join common code to mask high 4 bits

; Version 7 (faster)...Compute hash key = lower 12 bits of unsigned product:
;	(prefix code + suffix byte) * 15073
FHASH:	LD	L,A		; Extend suffix byte
	LD	H,0		;  to 16 bits
	ADD	HL,BC		; Sum with prefix code

; Note:	15073 = 2785 mod 4096, so we need only multiply by 2785.
	LD	D,H		; Copy sum, and compute in HL:
	LD	E,L		;    1 * sum
	ADD	HL,HL		;    2 * sum
	ADD	HL,HL		;    4 * sum
	ADD	HL,DE		;    5 * sum
	ADD	HL,HL		;   10 * sum
	ADD	HL,HL		;   20 * sum
	ADD	HL,DE		;   21 * sum
	ADD	HL,HL		;   42 * sum
	ADD	HL,DE		;   43 * sum
	ADD	HL,HL		;   86 * sum
	ADD	HL,DE		;   87 * sum
	ADD	HL,HL		;  174 * sum
	ADD	HL,HL		;  348 * sum
	ADD	HL,HL		;  696 * sum
	ADD	HL,HL		; 1392 * sum
	ADD	HL,HL		; 2784 * sum
	ADD	HL,DE		; 2785 * sum
	LD	A,H		; Setup high byte of result

; Common code for old-style hashing
HASH:	AND	0FH		; Mask hash key to 12 bits
	LD	H,A
	PUSH	HL		; Save key as trial string table index
	CALL	STRPTR		; Point to string table entry
	POP	DE		; Restore its index
	LD	A,(HL)		; Is table entry used?
	OR	A
	RET	Z		; No (that was easy), return table ptr

; Hash collision occurred.  Trace down list of entries with duplicate
; keys (in auxilliary table HSHT) until the last duplicate is found.
	LD	BC,HSHT		; Setup collision table base
	PUSH	HL		; Create dummy stack level
HASH1:	POP	HL		; Discard last index
	EX	DE,HL		; Get next trial index
	PUSH	HL		; Save it
	ADD	HL,HL		; Get ptr to collision table entry
	ADD	HL,BC
	LD	E,(HL)		; Fetch entry
	INC	HL
	LD	D,(HL)
	LD	A,D		; Is it zero?
	OR	E
	JR	NZ,HASH1	; No, loop for next in chain

; We now have the index (top of stack) and pointer (HL) for the last
; entry in the duplicate key list.  In order to find an empty spot for
; the new string, we search the string table sequentially starting 101
; (circular) entries past that of the last duplicate.
	EX	(SP),HL		; Save collision ptr, swap its index
	LD	E,101		; Move 101 entries past it
	ADD	HL,DE
HASH2:	RES	4,H		; Mask table index to 12 bits
	PUSH	HL		; Save index
	CALL	STRPTR		; Point to string table entry
	POP	DE		; Restore its index
	LD	A,(HL)		; Fetch byte from entry
	OR	A		; Is it empty?
	JR	Z,HASH3		; Yes, found a spot in table

	EX	DE,HL		; Else,
	INC	HL		; Bump index to next entry
	JR	HASH2		; Loop until we find one free

; We now have the index (DE) and pointer (HL) for an available entry
; in the string table.  We just need to add the index to the chain of
; duplicates for this hash key, and then return the pointer to caller.
HASH3:	EX	(SP),HL		; Swap ptr to last duplicate key entry
	LD	(HL),D		; Add this index to duplicate chain
	DEC	HL
	LD	(HL),E
	POP	HL		; Recover string table ptr
	RET			; Return it to caller

; Get fixed-length code from (old-style) crunched file -- These codes are
; packed in left-to-right order (msb first).  Two codes fit in three bytes,
; so we alternate processing every other call based on a rotating flag word
; in BITS (initialized to 55H).  Location BITSAV holds the middle byte
; between calls (coding assumes BITSAV = BITS-1).
OGETCR:	CALL	GETCX		; Get next input byte
	EXX			; Save output regs
	RET	C		; Return (carry set) if end of file

	LD	E,A		; Copy byte (high or low part of code)
	LD	HL,BITS		; Point to rotating bit pattern
	RRC	(HL)		; Rotate it
	JR	C,OGETC1	; Skip if this is high part of code

	DEC	HL		; Point to saved byte from last call
	LD	A,(HL)		; Fetch saved byte
	AND	0FH		; Mask low nibble (high 4 bits of code)
	EX	DE,HL		; Get new byte in L (low 8 bits of code)
	LD	H,A		; Form 12-bit code in HL
	RET			; Return (carry clear from mask)

OGETC1:	PUSH	DE		; Save byte just read (high 8 code bits)
	CALL	GETCX		; Get next byte
	EXX			; Save output regs
	POP	HL		; Restore previous byte in L
	RET	C		; But return if eof

	LD	(BITSAV),A	; Save new byte for next call
	AND	0F0H		; Mask high nibble (low 4 bits of code)
	RLA			; Rotate once through carry
	LD	H,A		; Set for circular rotate of HL & carry
	REPT	4
	ADC	HL,HL		; Form the 12-bit code
	ENDM
	RET			; Return (carry clear after last rotate)

; Output next byte decoded from crunched file
PUTCR:	EXX			; Swap in output registers
	JP	0		; Vector to the appropriate routine
PUTCRP	EQU	$-2		; (ptr to PUT or PUTUP stored here)

; Low-level output routines -- Register usage (once things get going):
;	B  = Flag for repeated byte expansion (1 = repeat count expected)
;	C  = Last byte output (saved for repeat expansion)
;	DE = Output buffer pointer
;	HL = CRC value
; Setup registers for output (preserves AF)
PUTSET:	LD	HL,(BUFPAG-1)	; Get buffer start address
	LD	L,0		; (It's always page aligned)
	EX	DE,HL
	LD	H,E		; Clear the CRC
	LD	L,E
	LD	B,E		; Clear repeat flag
	RET			; Return

; Table of starting output buffer pages (No. of entries must match ARCVER)
OBUFT:				; Header version:
	DB	HIGH BUFF	; 1 - Uncompressed (obsolete)
	DB	HIGH BUFF	; 2 - Uncompressed
	DB	HIGH BUFF	; 3 - Packed
	DB	HIGH BUFFSQ	; 4 - Squeezed
	DB	HIGH BUFFCX	; 5 - Crunched (unpacked) (old)
	DB	HIGH BUFFCX	; 6 - Crunched (packed) (old)
	DB	HIGH BUFFCX	; 7 - Crunched (packed, faster) (old)
	DB	HIGH BUFFCR	; 8 - Crunched (new)
	DB	HIGH BUFFCQ	; 9 - Squashed

; Unpack and output packed byte
PUTUP:	DJNZ	PUTUP4		; Expecting a repeat count?
	LD	B,A		; Yes ("byte REP count"), save count
	OR	A		; But is it zero?
	JR	NZ,PUTUP2	; No, enter expand loop (did one before)

	LD	A,REP		; Else ("REP 0"),
	JR	PUT		; Go output REP code as data

PUTUP1:	LD	A,C		; Get repeated byte
	CALL	PUT		; Output it
PUTUP2:	DJNZ	PUTUP1		; Loop until repeat count exhausted
	RET			; Return when done

PUTUP3:	INC	B		; Set flag for repeat count next
	RET			; Return (must wait for next call)

PUTUP4:	INC	B		; Normal byte, reset repeat flag
	CP	REP		; But is it the special flag code (REP)?
	JR	Z,PUTUP3	; Yes, go wait for next byte

	LD	C,A		; Save output byte for later repeat

; Output byte (and update CRC)
PUT:	LD	(DE),A		; Store byte in buffer
	XOR	L		; Include byte in lower CRC
	LD	L,A		;  to get lookup table index
	LD	A,H		; Save high (becomes new low) CRC byte
	LD	H,HIGH CRCTAB	; Point to table value low byte
	XOR	(HL)		; Include in CRC
	INC	H		; Point to table value high byte
	LD	H,(HL)		; Fetch to get new high CRC byte
	LD	L,A		; Copy new low CRC byte
	INC	E		; Now that CRC updated, bump buffer ptr
	RET	NZ		; Return if not end of page

	INC	D		; Point to next buffer page
	LD	A,(BUFLIM)	; Get buffer limit page
	CP	D		; Buffer full?
	RET	NZ		; No, return

; Output buffer
PUTBUF:	PUSH	HL		; Save register (i.e. CRC)
	LD	HL,(BUFPAG-1)	; Get buffer start address
	XOR	A		; (it's always page-aligned)
	LD	L,A
	EX	DE,HL		; Swap with buffer end ptr
	SBC	HL,DE		; Compute buffer length
	JR	Z,PUTB2		; But skip all the work if it's empty

	PUSH	BC		; Save register (i.e. repeat flag/byte)
	LD	B,H		; Copy buffer length
	LD	C,L
	LD	HL,(LEN)	; Get (remaining) output file length
	SBC	HL,BC		; Subtract size of buffer
	LD	(LEN),HL	; (Should be zero when we're all done)
	JR	NC,PUTB1	; Skip if double-precision not needed

	LD	HL,(LEN+2)	; Update upper word of length
	DEC	HL
	LD	(LEN+2),HL
PUTB1:	PUSH	DE		; Save buffer start
	CALL	WRTBUF		; Write the buffer
	POP	DE		; Reset output ptr for next refill
	POP	BC		; Restore register
PUTB2:	POP	HL		; Restore register
	RET			; Return to caller

; Write buffer to disk
WRTBUF:	LD	A,(OFLAG)	; Output file open?
	OR	A
	JR	Z,TYPBUF	; No, go typeout buffer instead

	LD	H,D		; Get buffer end ptr
	LD	L,E
	ADD	HL,BC
	JR	WRTB2		; Enter loop

WRTB1:	LD	(HL),CTLZ	; Fill last record with CP/M EOF...
	INC	HL
	INC	BC
WRTB2:	LD	A,L		; Buffer ends on a CP/M record boundary?
	AND	7FH
	JR	NZ,WRTB1	; No, loop until it does

	OR	B		; At least one page to write?
	JR	Z,WRTB4		; Skip if not

WRTB3:	PUSH	BC		; Save remaining byte count
	CALL	WRTREC		; Output 2 records to disk (i.e. 1 page)
	CALL	WRTREC		; (Note returns A=0 as expected below)
	POP	BC		; Restore count
	DJNZ	WRTB3		; Loop for all (full) pages in buffer

WRTB4:	OR	C		; Half-page left?
	RET	Z		; No, return

; Write record to disk
WRTREC:	LD	HL,128		; Get CP/M record length
	ADD	HL,DE		; Add buffer ptr
	PUSH	HL		; Save next record start
	CALL	SETDMA		; Set to write from buffer ptr
	LD	C,$WRITE	; Write a record to output file
	CALL	OFDOS
	POP	DE		; Restore ptr for next call
	DEC	A		; Write error?
	RET	Z		; No, return

	LD	DE,DSKFUL	; Disk is full, report error
	JP	PABORT		;  and abort

; Set input user code
InDu:	push	af		; save all registers
	push	bc
	push	de
	push	hl
	ld	a,(InUsr)	; get input file user
	jr	EndDU

; Set output user code
OutDU:	push	af
	push	bc
	push	de
	push	hl
	ld	a,(OutUsr)	; get output file user
;
EndDu:	ld	e,a
	ld	c,$CurUsr	; make it current user
	call	Bdos
	pop	hl
	pop	de
	pop	bc
	pop	af
	ret

; Typeout buffer
TYPBUF:	LD	A,(CHECKF)	; Just checking file?
	OR	A
	RET	NZ		; Yes, ignore buffer

	LD	A,(PROUTF)	; Printer output enabled?
	OR	A
	JR	NZ,PRTBUF	; Yes, go print buffer instead

; The file typeout facility was originally added to this program as an
; afterthought.  Areas for future improvement include intelligent handling
; of screen width and terminal characteristics.
TYPB0:	LD	A,(DE)		; Fetch next byte from buffer
	CP	CTLZ		; Is it CP/M end-of-file?
	JP	Z,EXIT		; Yes, exit program early

	PUSH	BC		; Save remaining byte count
	INC	A		; Bump ASCII code (simplifies DEL test)
	AND	7FH		; Mask to 7 bits
	CP	' '+1		; Is it a printable char?
	DEC	A		; (Restore code)
	JR	C,TYPB3		; Skip if non-printable

TYPB1:	CALL	PCHAR		; Type char
TYPB2:	INC	DE		; Bump ptr to next byte
	POP	BC		; Restore byte count
	DEC	BC		; Reduce count
	LD	A,B		; Done all bytes?
	OR	C
	JR	NZ,TYPB0	; No, loop for next
	RET			; Yes, return to caller

TYPB3:	CP	HT		; Is (non-printing) char a tab?
	JR	Z,TYPB1		; Yes, go type it
	JR	C,TYPB2		; But ignore if low control char
	CP	CR		; Does char generate a new line?
	JR	NC,TYPB2	; No, ignore control char (incl. CR)

	CALL	CRLF		; Yes (LF/VT/FF), start a new line
	PUSH	DE		; Save buffer ptr
	CALL	CABORT		; Good place to check for CTRL-C abort
	POP	DE		; Restore ptr
	LD	HL,LINCT	; Point to line count
	INC	(HL)		; Bump for one more line
	JR	Z,TYPB2		; But skip if 256 (must be no limit)

	LD	A,(TYLIM)	; Get max allowed lines
	CP	(HL)		; Reached limit (e.g. for RCP/M)?
	JR	NZ,TYPB2	; No, go back to typeout loop
	CALL	WHLCK		; But is wheel byte set?
	JR	Z,TYPB2		; Yes, do not enforce limit

	LD	DE,TYPERR	; Else, report too many lines
	JP	PABORT		;  and abort

; Print buffer -- This added as a quick hack to allow printing of highly-
; compressed binary plot images.  It may not be suitable for general text
; file listing.  (In particular, CTRL-Z is not treated as a file terminator.)
PRTBUF:	EX	DE,HL		; Buffer ptr -> HL
PRTB1:	LD	E,(HL)		; Fetch next byte from buffer
	PUSH	HL		; Save buffer ptr
	PUSH	BC		; Save remaining byte count
	LD	C,$LIST		; Print byte (on listing device)
	CALL	BDOS
	CALL	CABORT		; Check for CTRL-C abort
	POP	BC		; Restore byte count
	POP	HL		; Restore ptr
	INC	HL		; Bump to next byte in buffer
	DEC	BC		; Reduce count
	LD	A,B		; Done all bytes?
	OR	C
	JR	NZ,PRTB1	; No, loop for next

	RET			; Yes, return to caller

; Listing Routines
;
; List file information

LIST:	LD	HL,(TFILES)	; Get total files so far
	LD	A,H		; Test if this is first file
	OR	L
	INC	HL		; Add one more
	LD	(TFILES),HL	; Update total files
	CALL	Z,LTITLE	; If first file, list column titles
	LD	DE,SIZE		; Point to compressed file size
	PUSH	DE		; Save for later
	LD	HL,TSIZE	; Update total compressed size
	CALL	LADD
	LD	DE,LEN		; Point to uncompressed length
	PUSH	DE		; Save for later
	LD	HL,TLEN		; Update total length
	CALL	LADD
	LD	HL,LINE		; Setup listing line pointer
	LD	DE,OFCB+@FN	; List file name from output FCB
	LD	C,0		; (with blank fill)
	CALL	LNAME
	POP	DE		; Recover file length ptr
	PUSH	DE		; Save again for factor calculation
	CALL	LTODA		; List file length
	CALL	LDISK		; Compute and list disk space
	CALL	LSTOW		; List stowage method and version
	POP	BC		; Restore uncompressed length ptr
	POP	DE		; Restore compressed size ptr
	CALL	LSIZE		; List size and compression factor
	LD	A,(DATE)	; Check for valid file date
	OR	A		; (This anticipates no-date CP/M files)
	JR	NZ,LIST1	; Skip if valid

	LD	B,18		; Else, clear out date and time fields
	CALL	FILLB
	JR	LIST2		; Skip

LIST1:	CALL	LDATE		; List file date
	CALL	LTIME		; List file time
LIST2:	CALL	LCRC		; List CRC value

; Terminate and print listing line
LISTL:	LD	DE,LINE		; Setup listing line ptr
	JR	LIST3		; Go finish up and list it

; List file totals
LISTT:	LD	HL,LINE		; Setup listing line ptr
	LD	DE,(TFILES)	; List total files
	CALL	WTODA
	LD	DE,TLEN		; List total file length
	PUSH	DE		;  and save ptr for factor calculation
	CALL	LTODA
	LD	DE,(TDISK)	; List total disk space
	CALL	LDISK1
	LD	B,13		; Fill next columns with blanks
	CALL	FILLB
	POP	BC		; Recover total uncompressed length ptr
	LD	DE,TSIZE	; Get total compressed size ptr
	CALL	LSIZE		; List overall size, compression factor
	LD	B,20		; Fill next columns with blanks
	CALL	FILLB
	LD	DE,(TCRC)	; List sum of all CRC values
	CALL	WHEX
	LD	DE,TOTALS	; Point to totals string (precedes line)
LIST3:	LD	(HL),0		; Terminate listing line
	JR	PRINTL		; Go print it, followed by new line

; Print character
PCHAR:	CP	BEL		; Is it a noisy one?
	JR	NZ,PCHAR1	; No, skip
	LD	HL,BELLS	; Yes, is silence desired?
	AND	(HL)
	RET	Z		; Yes, keep quiet

PCHAR1:	PUSH	DE		; Save register
PCHAR2:	LD	E,A		; Setup char
	DEC	A		; But is it special program name marker?
	JR	Z,PNAME		; Yes, go insert name

	LD	C,$CONOUT	; Send to BDOS console output
	CALL	BDOS
	POP	DE		; Restore register
	RET			; Return

; Print program name string, followed by blank
PNAME:	LD	DE,USAGE	; Point to name string in help message
PNAME1:	LD	A,(DE)		; Reached trailing blank?
	CP	' '
	JR	Z,PCHAR2	; Yes, back to PCHAR to print it

	CALL	PCHAR		; Print name char
	INC	DE		; Point to next
	JR	PNAME1		; Loop until blank delimiter

; Print string on new line, then start another
PRINTX:	CALL	CRLF

; Print string, then start new line
PRINTL:	CALL	PRINTS

; Start new line -- Note: Must preserve DE
CRLF:	LD	A,CR
	CALL	PCHAR
	LD	A,LF
	CALL	PCHAR
	LD	HL,LPSCT	; Reached end of screen?
	DEC	(HL)
	RET	NZ		; No, return

	LD	A,0		; But are screen pauses enabled?
LPS	EQU	$-1		; (lines per screen = 0 if not)
	OR	A
	RET	Z		; No, return

	LD	(HL),A		; Reset count of lines left
	PUSH	DE		; Save register
	LD	DE,MORE		; Print '[more]' on the new line
	CALL	PRINTS
CRLF1:	CALL	CABORT		; Wait for char (or ^C abort)
	JR	Z,CRLF1

	PUSH	AF		; Save input response
	LD	DE,NOMORE	; Blank out the '[more]' line
	CALL	PRINTS
	POP	AF		; Restore response
	POP	DE		; Restore register
	XOR	' '		; Was response the space bar?
	RET	NZ		; Anything else scrolls another screen

	INC	A		; Yes, set to pause after one more line
	LD	(LPSCT),A
	RET			; Return

; Print string on new line -- Note: Restricted to at most 5 stack levels
; (c.f. CHECK).  CRLF will not perform page pause during this restriction,
; but PCHAR will execute PNAME (during ABOMSG print), so we're now at the
; limit!
PRINT:	CALL	CRLF

; Print NUL-terminated string
PRINTS:	LD	A,(DE)
	OR	A
	RET	Z

	CALL	P,PCHAR		; (Ignore help msg chars with MSB set)
	INC	DE
	JR	PRINTS

; Output warning message about extracted file
OWARN:	PUSH	DE
	LD	DE,WARN
	CALL	PRINTS
	POP	DE
	JR	PRINTL

; List column titles -- Note: This saves some much-needed space, by using
; the same template to generate the title line and the 'equal signs'
; separator line.
LTITLE:	CALL	CRLF
	LD	DE,TITLES
	PUSH	DE
	LD	A,(DE)
LTITL1:	CP	'='		; For titles, convert '=' to blank
	JR	NZ,LTITL2
	LD	A,' '
LTITL2:	CALL	PCHAR
	INC	DE
	LD	A,(DE)
	OR	A
	JR	NZ,LTITL1

	POP	DE
	CALL	CRLF
LTITL3:	LD	A,(DE)
	OR	A
	JR	Z,CRLF

	CP	' '		; Separator converts non-blank to '='
	JR	Z,LTITL4
	LD	A,'='
LTITL4:	CALL	PCHAR
	INC	DE
	JR	LTITL3

; List file name -- Note: We use name in output file FCB, rather than
; original name in archive header (illegal chars already filtered by GETNAM).
; This routine also called by INIT to unparse ARC file name.
LNAME:	LD	B,12		; Setup count for name, '.', and type
LNAME1:	LD	A,B		; Get count
	CP	4		; At end of name?
	LD	A,'.'
	JR	Z,LNAME2	; Yes, go store separator

	LD	A,(DE)		; Get next char
	INC	DE
	CP	C		; Ignore blanks (possibly)
	JR	Z,LNAME3

LNAME2:	LD	(HL),A		; Store char
	INC	HL
LNAME3:	DJNZ	LNAME1		; Loop for all chars in name and type
	RET			; Return to caller

; Compute and list disk space for uncompressed file
LDISK:	PUSH	HL		; Save line ptr
	LD	HL,(LEN)	; Convert file length to 1k disk space
	LD	A,(LEN+2)	; (Most we can handle here is 16 Mb)
	LD	DE,1023		; First, round up to next 1k
	ADD	HL,DE
	ADC	A,0
	RRA			; Now, shift to divide by 1k
	RR	H
	RRA
	RR	H
	AND	3FH
	LD	L,H		; Result -> HL
	LD	H,A
	LD	A,(LBLKSZ)	; Get disk block size
	DEC	A		; Round up result accordingly
	LD	E,A
	LD	D,0
	ADD	HL,DE
	CPL			; Form mask for lower bits
	AND	L
	LD	E,A		; Final result -> DE
	LD	D,H
	LD	HL,(TDISK)	; Update total disk space used
	ADD	HL,DE
	LD	(TDISK),HL
	POP	HL		; Restore line ptr
LDISK1:	CALL	WTODA		; List result
	LD	(HL),'k'
	INC	HL
	RET

; List stowage method and version
LSTOW:	CALL	FILL2B		; Blanks first
	EX	DE,HL
	LD	HL,STOWTX	; Point to stowage text table
	LD	A,(VER)		; Get header version no.
	PUSH	AF		; Save for next column
	LD	BC,8		; Use to get correct text ptr
	CP	3
	JR	C,LSTOW1
	ADD	HL,BC
	JR	Z,LSTOW1
	ADD	HL,BC
	CP	4
	JR	Z,LSTOW1
	ADD	HL,BC
	CP	9
	JR	C,LSTOW1
	ADD	HL,BC
	JR	Z,LSTOW1
	ADD	HL,BC
LSTOW1:	LDIR			; List stowage text
	EX	DE,HL		; Restore line ptr
	POP	AF		; Recover version no.
LSTOW2:	LD	B,3		; List in 3 cols, blank-filled
	JP	BTODB		;  and return

; List compressed file size and compression factor
LSIZE:	PUSH	DE		; Save compressed size ptr
	PUSH	BC		; Save uncompressed length ptr
	CALL	LTODA		; List compressed size
	POP	DE		; Recover length ptr
	EX	(SP),HL		; Save line ptr, recover size ptr

; Compute compression factor = 100 - [100*size/length]
;	(HL = ptr to size, DE = ptr to length, A = result)
	PUSH	DE		; Save length ptr
	CALL	LGET		; Get BCDE = size
	LD	H,B		; Compute 100*size
	LD	L,C		;  in HLIX:
	PUSH	DE
	POP	IX		;     size
	ADD	IX,IX
	ADC	HL,HL		;   2*size
	ADD	IX,DE
	ADC	HL,BC		;   3*size
	ADD	IX,IX
	ADC	HL,HL		;   6*size
	ADD	IX,IX
	ADC	HL,HL		;  12*size
	ADD	IX,IX
	ADC	HL,HL		;  24*size
	ADD	IX,DE
	ADC	HL,BC		;  25*size
	ADD	IX,IX
	ADC	HL,HL		;  50*size
	ADD	IX,IX
	ADC	HL,HL		; 100*size
	EX	(SP),HL		; Swap back length ptr, save upper
	CALL	LGET		; Get BCDE = length
	PUSH	IX
	POP	HL		; Now have (SP),HL = 100*size
	LD	A,B		; Length = 0?
	OR	C		; (Unlikely, but possible)
	OR	D
	OR	E
	JR	Z,LSIZE2	; Yes, go return result = 0

	LD	A,101		; Initialize down counter for result
LSIZE1:	DEC	A		; Divide by successive subtractions
	SBC	HL,DE
	EX	(SP),HL
	SBC	HL,BC
	EX	(SP),HL
	JR	NC,LSIZE1	; Loop until remainder < length

LSIZE2:	POP	HL		; Clean stack
	POP	HL		; Restore line ptr
	CALL	BTODA		; List the factor
	LD	(HL),'%'
	INC	HL
	RET			; Return

; List file creation date -- ARC files use MS-DOS 16-bit date format:
;	Bits [15:9] = year - 1980
;	Bits  [8:5] = month of year
;	Bits  [4:0] = day of month
; (All zero means no date, checked before call to this routine)
LDATE:	LD	A,(DATE)	; Get date
	AND	1FH		; List day
	CALL	BTODA
	LD	(HL),' '	; Then a blank
	INC	HL
	EX	DE,HL		; Save listing line ptr
	LD	HL,(DATE)	; Get date again
	PUSH	HL		; Save for listing year (in upper byte)
	ADD	HL,HL		; Shift month into upper byte
	ADD	HL,HL
	ADD	HL,HL
	LD	A,H		; Get month
	AND	0FH
	CP	13		; Make sure it's valid
	JR	C,LDATE1
	XOR	A		; (Else will show as "???")
LDATE1:	LD	C,A		; Use to index to 3-byte string table
	LD	B,0
	LD	HL,MONTX
	ADD	HL,BC
	ADD	HL,BC
	ADD	HL,BC
	LD	C,3
	LDIR			; Move month text into listing line
	EX	DE,HL		; Restore line ptr
	LD	(HL),' '	; Then a blank
	INC	HL
	POP	AF		; Recover high byte of date
	SRL	A		; Get 1980-relative year
	ADD	A,80		; Get true year in century
LDATE2:	LD	BC,256*2+'0'	; Setup for 2 digits with high-zero fill
	JR	BTOD		;  and convert binary to decimal ASCII

; List file creation time -- ARC files use MS-DOS 16-bit time format:
;	Bits [15:11] = hour
;	Bits [10:5]  = minute
;	Bits  [4:0]  = second/2 (not shown here)
LTIME:	EX	DE,HL		; Save listing line ptr
	LD	HL,(TIME)	; Fetch time
	LD	A,H		; Copy high byte
	RRA			; Get hour
	RRA
	RRA
	AND	1FH
	LD	B,'a'		; Assume am
	JR	Z,LTIME1	; Skip if 0 (12 midnight)

	CP	12		; Is it 1-11 am?
	JR	C,LTIME2	; Yes, skip

	LD	B,'p'		; Else, it's pm
	SUB	12		; Convert to 12-hour clock
	JR	NZ,LTIME2	; Skip if not 12 noon

LTIME1:	LD	A,12		; Convert 0 to 12
LTIME2:	PUSH	BC		; Save am/pm indicator
	ADD	HL,HL		; Shift minutes up to high byte
	ADD	HL,HL
	ADD	HL,HL
	PUSH	HL		; Save minutes
	EX	DE,HL		; Recover listing line ptr
	CALL	LSTOW2		; List hour
	LD	(HL),':'	; Then ":"
	INC	HL
	POP	AF		; Restore and list minutes
	AND	3FH
	CALL	LDATE2
	POP	AF		; Restore and list am/pm letter
	LD	(HL),A
	INC	HL
	RET			; Return

; List hex CRC value
LCRC:	CALL	FILL2B
	LD	DE,(CRC)
	PUSH	HL
	LD	HL,(TCRC)	; Update CRC total
	ADD	HL,DE
	LD	(TCRC),HL
	POP	HL

; List hex word in DE
WHEX:	CALL	DHEX
	LD	D,E

; List hex byte in D
DHEX:	LD	(HL),D
	RLD
	CALL	AHEX
	LD	A,D

; List hex nibble in A
AHEX:	OR	0F0H
	DAA
	CP	60H
	SBC	A,1FH
	LD	(HL),A
	INC	HL
	RET

; A few decimal ASCII conversion callers, for convenience
WTODA:	LD	B,5		; List blank-filled word in 5 cols
WTODB:	LD	C,' '		; List blank-filled word in B cols
	JR	WTOD		; List C-filled word in B cols

BTODA:	LD	B,4		; List blank-filled byte in 4 cols
BTODB:	LD	C,' '		; List blank-filled byte in B cols
	JR	BTOD		; List C-filled byte in B cols

LTODA:	LD	BC,9*256+' '	; List blank-filled long in 9 cols
;	JR	LTOD

; Convert Long (or Word or Byte) Binary to Decimal ASCII (R. A. Freed, 2.0,
; 15 Mar 85)
; Entry: A = Unsigned 8-bit byte value (BTOD)
;	DE = Unsigned 16-bit word value (WTOD)
;	DE = Pointer to low byte of 32-bit long value (LTOD)
;	 B = Max. string length (0 implies 256, i.e. no limit)
;	 C = High-zero fill (0 to suppress high-zero digits)
;	HL = Address to store ASCII byte string
; Return: HL = Adress of next byte after last stored
; Stack: n+1 levels, where n = no. significant digits in output
; Notes: If B > n, (B-n) leading fill chars (C non-zero) stored.
;	 If B < n, high-order (n-B) digits are suppressed.
;	 If only word or byte values need be converted, use the
;	  shorter version of this routine (WTOD or BTOD) instead.
RADIX	EQU	10		; (Will work with any radix <= 10)
LTOD:	PUSH	DE		; Entry for 32-bit long pointed to by DE
	EXX			; Save caller's regs, swap in alt set
	POP	HL		; Get pointer and fetch value to HADE
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	INC	HL
	LD	A,(HL)
	INC	HL
	LD	H,(HL)
	EX	DE,HL		; Value now in DAHL
	JR	LTOD1		; Join common code

BTOD:	LD	E,A		; Entry for 8-bit byte in A
	LD	D,0		; Copy to 16-bit word in DE
WTOD:	PUSH	DE		; Entry for 16-bit word in DE, save it
	EXX			; Swap in alt regs for local use
	POP	HL		; Recover value in HL
	XOR	A		; Set to clear upper bits in DE
	LD	D,A

; Common code for all entries
LTOD1:	LD	E,A		; Now have 32-bit value in DEHL
	LD	C,RADIX		; Setup radix for divides
	SCF			; Set first-time flag
	PUSH	AF		; Save for stack emptier when done

; Top of conversion loop -- Method:  Generate output digits on stack in
; reverse order.  Each loop divides the value by the radix.  Remainder is
; the next output digit, quotient becomes the dividend for the next loop.
; Stop when get zero quotient or no. of digits = max. string length.  (Always
; generates at least one digit, i.e. zero value has one "significant" digit.)
LTOD2:	CALL	DIVLB		; Divide to get next digit
	OR	'0'		; Convert to ASCII (clears carry)
	EXX			; Swap in caller's regs
	DJNZ	LTOD5		; Skip if still more room in string

; All done (value fills string), this is the output loop
LTOD3:	LD	(HL),A		; Store digit in string
	INC	HL		; Bump string ptr
LTOD4:	POP	AF		; Unstack next digit
	JR	NC,LTOD3	; Loop if any

	RET			; Return to caller

; Still more room in string, test if more significant digits
LTOD5:	PUSH	AF		; Stack this digit
	EXX			; Swap back local regs
	LD	A,H		; Last quotient = 0?
	OR	L
	OR	D
	OR	E
	JR	NZ,LTOD2	; No, loop for next digit

; Can stop early (no more digits), handle leading zero-fill (if any)
	EXX			; Swap back caller's regs
	OR	C		; Any leading fill wanted?
	JR	Z,LTOD4		; No, go to output loop

LTOD6:	LD	(HL),A		; Store leading fill
	INC	HL		; Bump string ptr
	DJNZ	LTOD6		; Repeat until fill finished
	JR	LTOD4		; Then go store the digits

; Miscellaneous Support Routines
;
; EatSpc -- gobbles up spaces.  Expects address of string in HL, length
; of string in BC.  Returns non-space character in A, address of character
; in HL, remaining string length in BC.
EatSpc:	ld	a,(hl)		; get character
	inc	hl		; increment pointer
	dec	bc		; decrement counter
	cp	a,' '		; is it a space
	jr	z,EatSpc	; (yes, eat it)
	dec	hl		; no, back up pointer
	inc	bc		; ..and counter
	ret
;
; Note: The following general-purpose routine is currently used in this
; program only to divide longs by 10 (by decimal convertor, LTOD).  Thus,
; a few unneeded code locations have been commented out.
;
; Unsigned Integer Division of Long (or Word or Byte) by Byte (R. A. Freed)
; Divisor in C, dividend in (A)DEHL or (A)HL or L (depends on call used).
; Quotient returned in DEHL (or just HL), remainder in A.
;DIVXLB: OR	A		; 40-bit dividend in ADEHL (A < C)
;	JR	NZ,DIVLB1	; Skip if have more than 32 bits
DIVLB:	LD	A,D		; 32-bit dividend in DEHL
	OR	E		; But is it really only 16 bits?
	JR	Z,DIVWB		; Yes, skip (speeds things up a lot)

	XOR	A		; Clear high quotient for first divide
DIVLB1:	CALL	DIVLB2		; Get upper quotient first, then swap:
DIVLB2:	EX	DE,HL		; Upper quotient in DE, lower in HL
DIVXWB:	OR	A		; 24-bit dividend in AHL (A < C)
	JR	NZ,DIVWB1	; Skip if have more than 16 bits

DIVWB:	LD	A,H		; 16-bit dividend in HL
	CP	C		; Will quotient be less than 8 bits?
	JR	C,DIVBB1	; Yes, skip (small dividend speed-up)

	XOR	A		; Clear high quotient
DIVWB1:	LD	B,16		; Setup count for 16-bit divide
	JR	DIVB		; Skip to divide loop

;DIVBB:	XOR	A		; 8-bit dividend in L
DIVBB1:	LD	H,L		; For very small nos., pre-shift 8 bits
	LD	L,0		; High byte of quotient will be zero
	LD	B,8		; Setup count for 8-bit divide

; Top of divide loop (vanilla in-place shift-and-subtract)
DIVB:	ADD	HL,HL		; Divide AHL (B=16) or AH (B=8) by C
	RLA			; Shift out next remainder bit
;	JR	C,DIVB1		; (This needed only for divsors > 128)
	CP	C		; Greater than divisor?
	JR	C,DIVB2		; No, skip (next quotient bit is 0)

DIVB1:	SUB	C		; Yes, reduce remainder
	INC	L		;  and set quotient bit to 1
DIVB2:	DJNZ	DIVB		; Loop for no. bits in quotient
	RET			; Done (quotient in HL, remainder in A)

; Fetch a long (4-byte) value
LGET:	LD	E,(HL)		; Fetch BCDE from (HL)
	INC	HL
	LD	D,(HL)
	INC	HL
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	RET

; Add two longs
LADD:	LD	B,4		; (DE) + (HL) -> (HL)
	OR	A
LADD1:	LD	A,(DE)
	ADC	A,(HL)
	LD	(HL),A
	INC	HL
	INC	DE
	DJNZ	LADD1

	RET

; Fill routines
FILL2B:	LD	B,2		; Fill 2 blanks
FILLB:	LD	C,' '		; Fill B blanks
FILL:	LD	(HL),C		; Fill B bytes with char in C
	INC	HL
	DJNZ	FILL

	RET

; Convert character to upper case
UPCASE:	CP	'a'
	RET	C
	CP	'z'+1
	RET	NC

	ADD	A,'A'-'a'
	RET
;
; Messages and Initialized Data
;
NOTZ80:	DB	BEL,'Z80 required!$'
ABOMSG:	DB	BEL,1,'aborted!',0
CPMERR:	DB	'CP/M version 2 or higher required',0
NOROOM:	DB	'Not enough memory',0
NAMERR:	DB	'Ambiguous archive file name',0
OPNERR:	DB	'Cannot find archive file',0
FMTERR:	DB	'Invalid archive file format',0
HDRERR:	DB	BEL,'Warning: Bad archive file header, bytes skipped = '
HDRSKP:	DB	'00000',0
NOFILS:	DB	'No matching file(s) in archive',0
BADIDR:	DB	'Invalid archive file directory',0
BADODR:	DB	'Invalid output directory',0
ARCMSG:	DB	'Archive File = '
InDrv:	db	'A00:',0
ARCNAM:	DB	'FILENAME.ARC',0
OUTMSG:	DB	'Output Directory = '
OUTDRV:	DB	'A00:',0
CHKMSG:	DB	'Checking archive...',0
BADVER:	DB	'Cannot extract file (need newer version of UNARC?)',0
EXISTS:	DB	BEL,'Replace existing output file (y/n)? ',0
DSKFUL:	DB	'Disk full',0
DIRFUL:	DB	'Directory full',0
CLSERR:	DB	'Cannot close output file',0
UCRERR:	DB	'Incompatible crunched file format',0
TYPERR:	DB	'Typeout line limit exceeded',0
WARN:	DB	BEL,'Warning: Extracted file has incorrect ',0
CRCERR:	DB	'CRC',0
LENERR:	DB	'length',0
MORE:	DB	'[more]',0
NOMORE:	DB	CR,'       ',HT,CR,0
; Note:	Tab (HT) added above in UNARC 1.5 for proper following tab expansion
; (since CP/M 2.2 BDOS does not reset its column position after raw CR
; output).  The blanks are still generated in case of BDOS implementations
; which do not expand tabs.
MONTX:	DB	'???JanFebMarAprMayJunJulAugSepOctNovDec'
STOWTX:	DB	'Unpacked'
	DB	' Packed '
	DB	'Squeezed'
	DB	'Crunched'
	DB	'Squashed'
	DB	'Unknown!'
TITLES:	DB	'Name========  =Length  Disk  =Method= Ver =Stored Save'
	DB	'd ===Date== =Time=  CRC='
LINLEN	EQU	$-TITLES
	DB	0
TOTALS:	DB	'        ====  =======  ====               =======  ==='
	DB	'                    ===='
	DB	CR,LF
	DB	'Total  '	; (LINE must follow!)

; .COM file ends here (except for non-Z80 self-unpacking startup code)

COMLEN	EQU	$-TBASE		; Length of initialized code and data

; Data Storage
;
; Unitialized data last (does not contribute to .COM file size)
;
; Note:	Following macro introduced in UNARC 1.5 to avoid use of the assembler
; DS directive, which generates unneeded records in the .COM file when linked
; with L80 (unlike SLRNK).  (Also preserves location counter for self-
; unpacking initialization code in the non-Z80 version.)
DSS	MACRO	SYM,BYTES
SYM	EQU	$D
$D	DEFL	$D+(BYTES)
	ENDM

$D	DEFL	$		; Start of data storage (pseudo PC)
	DSS	LINE,LINLEN+1	; Listing line buffer (follow TOTALS!)
$D	DEFL	$D+(30*2)	; Program stack (25 levels)
STACK	EQU	$D		; (Too small will only garbage listing)
TOTS	EQU	$D		; Start of listing totals
	DSS	TFILES,2	;  Total files processed
	DSS	TLEN,4		;  Total uncompressed bytes
	DSS	TDISK,2		;  Total 1K disk blocks
	DSS	TSIZE,4		;  Total compressed bytes
	DSS	TCRC,2		;  Total of all CRC values
	DSS	LINCT,1		; Line count for file typeout
	DSS	ARKFLG,1	; Default file type flag (allows .ARC)
	DSS	PROUTF,1	; Printer output flag
	DSS	CHECKF,1	; Check archive validity flag
TOTC	EQU	$D-TOTS		; Count of bytes to clear
	dss	WHEEL,2		; Address of "wheel" byte (this pointer
				;  is now filled in by INIT routine
	dss	DefUsr,1	; Current (default) user code
	dss	InUsr,1		; Input file user code
	dss	OutUsr,1	; Output file user code
	DSS	GETPTR,2	; Input buffer pointer
	DSS	LPSCT,1		; Lines per screen counter
	DSS	LBLKSZ,1	; Disk allocation block size for listing
	DSS	TNAME,11	; Test pattern for selecting file names
	DSS	OFCB,@FCBSZ	; Output file FCB
;	DSS	IFCB,@FCBSX	; Input file FCB
IFCB	EQU	DFCB		; (Currently using default FCB instead)
HDRBUF	EQU	$D		; Archive file header buffer...
	DSS	VER,1		; Header version no. (stowage type)
	DSS	NAME,13		; Name string (NUL-terminated)
	DSS	SIZE,4		; Compressed bytes
	DSS	DATE,2		; Creation date
	DSS	TIME,2		; Creation time
	DSS	CRC,2		; Cyclic check of uncompressed file
	DSS	LEN,4		; Uncompressed bytes (version > 1)
HDRSIZ	EQU	$D-HDRBUF	; Header size (4 less if version = 1)
MINMEM	EQU	$D-1		; Min memory limit (no file output)

; Data for file output processing only
				; Following order required:
	DSS	BUFPAG,1	;  Output buffer start page
	DSS	BUFLIM,1	;  Output buffer limit page
				; Following order required:
	DSS	CODES,1		;  Code count for crunched input
	DSS	BITSAV,1	;  Bits save for crunched input
	DSS	BITS,1		;  Bit count for crunched input
	DSS	STRCT,2		; No. entries in crunched string table

; Tables and buffers for file output (All of the following must be page-
; aligned)
$D	DEFL	($D+255) AND 0FF00H ; Align to page boundary
	DSS	CRCTAB,256*2	; CRC lookup table (256 2-byte values)
BUFF	EQU	$D		; Output buff for non-squeezed/crunched
				; or:
TREE	EQU	$D		; Decoding tree for squeezed files
TREESZ	EQU	256*4		; (256 4-byte nodes)
BUFFSQ	EQU	TREE+TREESZ	; Output buffer for squeezed files
				; or:
STRT	EQU	$D		; String table for crunched files
STRSZ	EQU	4096*3		; (4K 3-byte entries)
BUFFCR	EQU	STRT+STRSZ	; Output buffer for newer crunched files
				; plus (for old-style crunched files):
HSHT	EQU	BUFFCR		; Extra table for hash code chaining
HSHSZ	EQU	4096*2		; (4K 2-byte entries)
BUFFCX	EQU	HSHT+HSHSZ	; Output buffer for older crunched files
				; or (for squashed files):
STQSZ	EQU	8192*3		; (8K 3-byte string table entries)
BUFFCQ	EQU	STRT+STQSZ	; Output buffer for squashed files

; That's all, folks!
  IF	($ AND 7FH) NE 0
; Clear out final record of the .COM file (Needed only for precise M80/L80
; compatibility with Z80ASM/SLRNK)
	REPT	128-($ AND 7FH)
	DB	0
	ENDM
  ENDIF
;
	END	BEGIN