; UNARCZ -- CP/M Archive File Extractor
;
Vers	equ	13		; 9 December 1990
;
; This ZCPR3 utility is based on Robert Freed's UNARC version 1.6.
;
;	Gene Pizzetta		Voice:  (617) 284-0891
;	481 Revere St.		Newton Centre Z-Node:  (617) 965-7259
;	Revere, MA 02151
;
; Modification history has been moved to a separate file.  (Remember
; to update version/date here and maintain history log.)
;
; Copyright 1986, 1987 by Robert A. Freed
;
;
; ARC file parameters
ARCMARK	equ	26		; archive header marker byte
; 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		; system base/warm boot
BDOS	equ	BOOT+005h	; BDOS entry
MEMTOP	equ	BDOS+1		; top of TPA vector
DFCB	equ	BOOT+05Ch	; default file control block
SFCB	equ	BOOT+06Ch	; secondary file control block
DBUF	equ	BOOT+080h	; default DMA buffer
TBASE	equ	BOOT+100h	; TPA base
;
; BDOS function codes
$CONIN	equ	1		; console input
$CONOUT	equ	2		; console output
$LIST	equ	5		; listing output
$PRTSTR	equ	9		; console string output
$CONST	equ	11		; console status
$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
$WRITE	equ	21		; write sequential
$MAKE	equ	22		; make file
$DISK	equ	25		; current disk
$SETDMA	equ	26		; set DMA address
$GETDPB	equ	31		; disk parameter block address
$CurUsr	equ	32		; get/set user
$READR	equ	33		; read random
$RECORD	equ	36		; set random record
$DosVer	equ	48		; extended BDOS version
$SetStp	equ	103		; set file date stamp
;
; FCB offsets
@DR	equ	0		; drive code
@FN	equ	1		; filename
@FT	equ	9		; filetype
@USR	equ	13		; user code
@BAD	equ	15		; bad du flag
@CR	equ	32		; current record
@RN	equ	33		; random record number (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
@LPS	equ	50		; address of number of screen lines
;
; 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)
;
	org	TBASE		; COM file starts here
;
	jp	BEGIN
;
	db	'Z3ENV'
	db	1
Z3EAdr:	dw	0		; environment address
;
; Patchable options -- 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 off, no file output is allowed.  Also, BLKSZ and/or
; TYPGS are assumed to be 1, if they are zero by default.  If the wheel
; byte is on, TYFLG and TYLIM are not enforced (unlimited typeout allowed).
;
	db	0,0		; filler
;
; Following is name for ZCNFG configuration file in case program is renamed
	db	'UNARCZ',Vers/10+'0',Vers mod 10+'0'
;
; High memory pages to save (8=2K, the norm).  A zero clobbers CPR and
; forces warm boot.  Some non-standard systems might require 9 or 10.
CCPSV:	db	8
;
; Default disk allocation block size in K to you when no output drive is
; given.  Zero uses default drive's block size.
BLKSZ:	db	0
;
; Enables/disables file type-out when Wheel is off.  Zero disables type-out.
TYFLG:	db	0FFh
;
; Number of buffer pages for type-out.  Zero is for the maximum.
; One (1) minimizes viewing waits, but may cause excess floppy motor
; starting and stopping.
TYPGS:	db	0
;
; Line limit for type-out when Wheel byte is off.  Zero for no limit.
TYLIM:	db	0
;
; Enables/disables bell for warning and error messages.  Zero disables bells.
BELLS:	db	0FFh
;
; Ask/don't ask before erasing existing files when extracting to disk.
; Non-zero for don't ask.
EFlag:	db	0
;
; Page/don't page screen output during directory display or file typing.
; Non-zero for don't page.
NFlag:	db	0
;
; Table of filetypes disallowed for type-out
NOTYP:	db	'COM'		; CP/M or MS-DOS binary
	db	'EXE'		; MS-DOS executable
	db	'OBJ'		; renamed COM
	db	'OV?'		; binary overlay
	db	'REL'		; relocatable object
	db	'?RL'		; other relocatables (PRL, CRL, IRL, etc.)
	db	'INT'		; intermediate compiler code
	db	'SYS'		; system file
; the following are unlikely in an archive . . .
	db	'BAD'		; bad disk block
	db	'LBR'		; library
	db	'ARC'		; MS-DOS archive
	db	'ARK'		; CP/M archive (ditto)
	db	'?Q?'		; squeezed file
	db	'?Z?'		; crunched (or ZOO'd) file
	db	'?Y?'		; LZH encoded
; Additional types may be added below.  To remove one of the above
; types without replacing it, simply set the MSB in any byte.
	db	'COM'
	db	'COM'
	db	'COM'
	db	'COM'
	db	'COM'
	db	0		; End of table (20 total)
;
; Program begins -- self-initializing, may be re-executed multiple times
; with the ZCPR3 GO command.
BEGIN:	ld	(SPSAV),sp	; Save CCP stack
	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	(NoLPS),a
	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	prints
	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,(Z3EAdr)
	ld	de,@LPS		; offset to CRT lines
	add	hl,de
	ld	a,(hl)		; get number of lines
	dec	a		; make it one less
	ld	(NoLPS),a	; ..and store them
	ld	(LPS),a		; Set lines per screen (enables pauses)
	ld	(LPSCT),a	; Init count of lines until next pause
	ld	a,(NFlag)	; what is the configuration default?
	or	a
	jr	z,Init0		; (we page)
	xor	a		; set no paging
	ld	(LPS),a
	ld	(LPSCT),a
Init0:	ld	(OpEFlg),a	; reset erase flag
	ld	a,(EFlag)	; what is the configuration default?
	or	a
	jr	z,Init1		; (ask first)
	ld	a,0FFh		; (erase without asking)
	ld	(OpEFlg),a
Init1:	ld	hl,DBUF+1	; Point to command line buffer
	ld	a,(dbuf)	; get length
	or	a		; anything there?
	jp	z,Usage		; (no)
	ld	c,a		; put count in BC
	ld	b,0
	call	EatSpc		; ignore spaces
	or	a		; at the end?
	jp	z,Usage		; (yes, give usage)
	cp	'/'		; request for help?
	jp	z,Usage		; (yes)
	ld	a,' '		; get past first token
	cpir
	jr	nz,init2	; (no option)
	call	EatSpc
	cp	'/'		; options yet?
	jr	z,OptLp		; (yes, get them)
	or	a		; at the end?
	jr	z,init2		; (yes)
	ld	a,' '		; get past second token
	cpir
	jr	nz,init2	; (no option)
	call	EatSpc
	or	a
	jr	z,init2
	cp	'/'		; delimiter?
	jr	nz,NoSlsh	; (nope)
OptLp:	inc	hl		; yes, ignore it
	ld	a,(hl)
NoSlsh:	or	a
	jr	z,init2
	cp	'N'		; is it 'N'?
	call	z,OptN		; (yes, no paging)
	cp	'P'		; Is it 'P' ?
	call	z,OptP
	cp	'C'
	call	z,OptC
	cp	'E'
	call	z,OptE
	jr	OptLp
;
Init2:	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
	xor	a		; store final null
	ld	(hl),a
	ld	a,(IFcb)	; do we have a input drive?
	or	a
	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+@BAD)	; check for bad output DU
	or	a
	ld	de,BADODR
	jp	nz,PABORT	; (report bad output DU and abort)
	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
	xor	a		; store final null
	ld	(hl),a
	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
	ld	a,'/'		; is it options?
	cp	(hl)
	ld	a,' '		; set space for existence tests
	jr	z,Init2c	; (it's options)
	cp	(hl)		; Output file name specified?
	jr	nz,INIT3	; (Yes, go move it)
Init2c:	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,Usage		; (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	hl,IFcb		; point to ARC file FCB
	ld	a,(IFcb+@BAD)	; Check for bad DU
	or	a
	ld	de,BADIDR
	jp	nz,PABORT	; (report bad input DU 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	prints
	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	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
;
; Set options
OptN:	push	af
	ld	a,(LPS)		; get current setting
	or	a
	jr	z,OptN1		; (no paging, so reverse it)
	xor	a		; set to zero
	ld	(LPS),a		; Set lines per screen (enables pauses)
	ld	(LPSCT),a	; Init count of lines until next pause
	pop	af
	ret

OptN1:	ld	a,(NoLPS)	; get screen line count
	ld	(LPS),a		; ..and store it where needed
	ld	(LPSCT),a
	pop	af
	ret
;
OptP:	ld	(OpPFlg),a	; Yes, set printer output flag
	ret
;
OptC:	ld	(OpCFlg),a	; Yes, set check archive flag
	ret
;
OptE:	push	af
	ld	a,(OpEFlg)	; get current setting (0 or FFh)
	xor	0FFh
	ld	(OpEFlg),a
	pop	af
	ret
;
; Display program usage help message
Usage:	ld	de,MsgUse	; print sign-on
	call	prints
	call	PName		; print program name
	ld	de,MsgUs1
	call	prints
	call	WhlCk		; check wheel byte
	push	af
	or	a
	ld	de,MsgUs2
	call	z,prints	; print if wheel
Usage1:	ld	de,MsgUs3
	call	prints
	pop	af		; check wheel again
	push	af
	or	a
	ld	de,MsgUs4
	call	z,prints	; print if wheel
Usage2:	ld	a,(TyFlg)	; typeout allowed?
	or	a
	jr	nz,Usag2a	; no, except for wheel
	pop	af
	push	af
	or	a
	jr	nz,Usag2b	; (yes, at all times)
Usag2a:	ld	de,MsgUs5
	call	prints
Usag2b:	ld	de,MsgUs6
	call	prints
	ld	a,(NFlag)	; check configuration default
	or	a
	jr	nz,Usage3
	ld	de,MsgNot
	call	prints
Usage3:	ld	de,MsgUs7
	call	prints
	pop	af		; check wheel again
	push	af
	or	a
	jr	nz,Usage5	; (no wheel)
	ld	de,MsgUs8
	call	prints
	ld	a,(EFlag)	; check configuration default
	or	a
	jr	z,Usage4
	ld	de,MsgNot
	call	prints
Usage4:	ld	de,MsgUs9
	call	prints
Usage5:	ld	de,MsgX1	; archive directory examples
	call	prints
	call	PName
	ld	de,MsgX1a
	call	prints
	call	PName
	ld	de,MsgX1b
	call	prints
	ld	a,(TyFlg)	; check type-out flag
	or	a
	jr	nz,Usag5a	; (yes, at all times)
	pop	af
	push	af
	or	a
	jr	nz,Usage6	; (not wheel)
Usag5a:	ld	de,MsgX2	; member type-out example
	call	prints
	call	PName
	ld	de,MsgX2a
	call	prints
Usage6:	pop	af		; check wheel byte
	or	a
	jr	nz,Usage7	; (no wheel)
	ld	de,MsgX3	; extraction examples
	call	prints
	call	PName
	ld	de,MsgX3a
	call	prints
	call	PName
	ld	de,MsgX3b
	call	prints
	ld	de,MsgX4	; printing and checking examples
	call	prints
	call	PName
	ld	de,MsgX4a
	call	prints
	call	PName
	ld	de,MsgX4b
	call	prints
Usage7:	ld	de,MsgCop	; print copyright
	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	; (we've got a wheel)
	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)
	or	a		; file open?
	call	nz,CLOSE	; (yes, close input file (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)
	or	a		; file open?
	call	nz,CLOSE	; (yes, close it)
	inc	a
	ret	z		; (return zero if error)
	ld	a,(OFLAG)	; file open?
	or	a
	call	nz,DatStp	; (yes, write date stamp)
	xor	a		; make A non-zero
	inc	a
	ret
;
; Close a file if open
CLOSE:	ld	c,$CLOSE	; Yes, close it
	call	BDOS
	inc	a		; check for error
	ret			; Return to caller with Z-flag on 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	hl,OpCFlg	; 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	(OpPFlg),a	; No printing allowed
	ld	a,(TYFLG)	; Fetch flag for typeout allowed
OUTS1:	ld	c,a		; Save typeout flag (always if wheel)
	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
	ld	c,a		; Save output drive in C
	ld	a,b		; check wheel
	or	a
	ld	de,MsgNoE
	jp	z,PAbort	; (tell 'em we can't do that)
	xor	a		; disable screen paging
	ld	(LPS),a
	ld	a,c		; get back output drive
	push	bc
	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	bc		; Recover output drive
;	cp	c		; Test if same as default
	pop	de		; Recover output drive <crw>
	cp	e		; Test if same as default <crw>
	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,(OpPFlg)	; 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	a,(OpEFlg)	; E option?
	or	a
	jr	nz,OutD1a	; (yes, erase without asking)
	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		; (aborted)
	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)
OutD1a:	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
	jp	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 or output user code
InDu:	push	af		; save all registers
	push	bc
	push	de
	push	hl
	ld	a,(InUsr)	; get input file user
	jr	EndDU
;
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
;
; Convert MS-DOS date/time to CP/M universal date/time
M2CTim:	push	de
	ld	c,(hl)
	inc	hl
	ld	b,(hl)
	ld	a,b
	or	c
	jr	z,M2CTm3
	ld	a,b
	srl	a
	cp	62h
	jr	nc,M2CTm3
	sub	14h
	jr	nc,M2CTm1
	add	a,64h
M2CTm1:	ld	(de),a
	inc	de
	ld	a,c
	rr	b
	rla
	rla
	rla
	rla
	and	0Fh
	ld	(de),a
	inc	de
	ld	a,c
	and	1Fh
	ld	(de),a
	inc	de
	inc	hl
	inc	hl
	ld	b,(hl)
	dec	hl
	ld	c,(hl)
	ld	a,b
	rra
	rra
	rra
	and	1Fh
	ld	(de),a
	inc	de
	ld	a,b
	and	7
	rl	c
	rla
	rl	c
	rla
	rl	c
	rla
	ld	(de),a
	pop	de
	ld	b,5
M2CTm2:	ld	a,(de)
	call	BinBcd
	ld	(de),a
	inc	de
	djnz	M2CTm2
	xor	a
	ret
;
M2CTm3:	pop	de
	xor	a
	ld	b,5
M2CTm4:	ld	(de),a
	inc	de
	djnz	M2CTm4
	dec	a
	ret
;
BinBcd:	push	bc
	ld	b,0FFh
BinBc1:	inc	b
	sub	0Ah
	jr	nc,BinBc1
	add	a,0Ah
	ld	c,a
	ld	a,b
	add	a,a
	add	a,a
	add	a,a
	add	a,a
	add	a,c
	pop	bc
	ret
;
; Store date stamp to disk if ZSDOS
DatStp:	ld	a,(Date)	; check for date
	or	a
	ret	z		; (none, forget it)
	push	bc
	push	de
	push	hl
	ld	c,$DosVer	; check for extended BDOS
	call	Bdos
	ld	a,l
	or	a
	jr	z,DSExit	; (nope)
	ld	a,h
	cp	'S'		; ZSDOS?
	jr	z,DatSp1	; (yes)
	cp	'D'		; ZDDOS?
	jr	nz,DSExit	; (no)
DatSp1:	ld	b,5		; zero out access date
	ld	c,0
	ld	hl,CDate+5
	call	FILL
	ld	hl,CDate	; move create date to modify date
	ld	de,CDate+10
	ld	bc,5
	ldir
	ld	de,CDate
	call	setdma
	call	OutDU
	ld	de,OFCB
	xor	a
	ld	(OFCB+12),a	; zero extent
	ld	(OFCB+@CR),a	; ..and current record
	ld	c,$SetStp	; set file stamp
	call	Bdos
DSExit:	pop	hl
	pop	de
	pop	bc
	ret
;
; Type out buffer
TYPBUF:	ld	a,(OpCFlg)	; Just checking file?
	or	a
	ret	nz		; (Yes, ignore buffer)
	ld	a,(OpPFlg)	; 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
	push	hl
	ld	hl,CDate	; fill universal date with nulls
	ld	b,15
	ld	c,0
	call	FILL
	pop	hl
	jr	LIST2		; Skip
;
LIST1:	push	hl
	push	de
	ld	hl,Date		; point to MS-DOS date/time
	ld	de,CDate	; point to universal time string
	call	M2CTim		; convert it
	pop	de
	pop	hl
	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
;
; 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 D
PCHAR2:	ld	e,a		; setup char
	ld	c,$CONOUT	; print it
	call	BDOS
	pop	de		; restore register
	ret
;
; Print program name string, followed by blank
PName:	ld	de,PrgNam	; do we already have a name?
	ld	a,(de)
	cp	' '
	jr	nz,PName3	; (yes, so use it)
	push	de		; save pointer
	call	getefcb		; get external FCB address
	jr	z,PName1	; (we don't have one)
	inc	hl		; point to filename
	jr	PName2
;
PName1:	ld	hl,MsgUse	; get name from help message
PName2:	pop	de		; point D to PrgNam
	push	de		; and save it again
	ld	bc,8
	ldir
	pop	de		; point to PrgNam
PName3:	ld	a,(de)		; get character
	cp	' '		; trailing blank?
	ret	z		; (yes, we're through)
	call	PCHAR1		; print name char
	inc	de		; point to next
	jr	PName3		; loop until blank
;
; 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.
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:	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	' '		; 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: ora	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:	xra	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
;
; Get address of external FCB, returns Z if none
getefcb:
	push	de
	ld	hl,(Z3EAdr)	; get environment address
	ld	de,24h		; offset
	add	hl,de
	ld	a,(hl)		; get address in HL
	inc	hl
	ld	h,(hl)
	ld	l,a
	pop	de
	ld	a,h		; check for existence
	or	l
	ret
;
; Messages and initialized data
;
; Program usage displays if no command line parameters, if '//' option
; is given, and on attempts to type a COM file.
MsgUse:	db	'UNARCZ   '
	db	'ZCPR3 Archive File Extractor   Version '
	db	Vers/10+'0','.',Vers mod 10+'0'
	db	CR,LF
	db	'Usage:',CR,LF
	db	'   ',0
MsgUs1:	db	' {dir:}arcfile{.typ} ',0
MsgUs2:	db	'{dir:}',0
MsgUs3:	db	'{afn.aft} {{/}options}',CR,LF
	db	'An ambiguous output filename (or no filename)',CR,LF
	db	' implies archive directory display.',CR,LF,0
MsgUs4:	db	'An output DU implies file extraction.',CR,LF,0
MsgUs5:	db	'An unambiguous filename implies type-out.',CR,LF,0
MsgUs6:	db	'Options:',CR,LF,'   N   ',0
MsgUs7:	db	'Page screen output.',CR,LF,0
MsgUs8:	db	'   C   Check validity of archive.',CR,LF
	db	'   E   ',0
MsgUs9:	db	'Erase existing files without asking.',CR,LF
	db	'   P   Send output to printer.',CR,LF,0
MsgNot:	db	'Don''t ',0
MsgX1:	db	'Examples:',CR,LF
	db	'   B0>',0
MsgX1a:	db	' A3:SAVE.ARK *.*  '
	db	'; list all files in archive SAVE in A3',CR,LF
	db	'   A0>',0
MsgX1b:	db	' SAVE *.DOC N     '
	db	'; list just DOC files with no pauses',CR,LF,0
MsgX2:	db	'   A0>',0
MsgX2a:	db	' SAVE READ.ME     '
	db	'; type the file READ.ME to the screen',CR,LF,0
MsgX3:	db	'   A0>',0
MsgX3a:	db	' SAVE C3:         '
	db	'; extract all files to directory C3',CR,LF
	db	'   A1>',0
MsgX3b:	db	' SAVE B:*.DOC     '
	db	'; extract DOC files to directory B1',CR,LF,0
MsgX4:	db	'   A0>',0
MsgX4a:	db	' SAVE PRN.DAT P   '
	db	'; send the file PRN.DAT to the printer',CR,LF
	db	'   A0>',0
MsgX4b:	db	' SAVE *.* C       '
	db	'; check validity of all files in archive',CR,LF,0
MsgCop:	db	'Copyright 1986, 1987 by Robert A. Freed.',0
; (We'd like to be unobtrusive, but please don't remove or patch out above)
;
PrgNam:	db	'         '
ABOMSG:	db	BEL,'  Aborted!',0
NOROOM:	db	'  Not enough memory,',0
NAMERR:	db	'  Ambiguous archive filename,',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
MsgNoE:	db	'  No disk output allowed,',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 ***
;
COMLEN	equ	$-TBASE		; Length of initialized code and data
;
; Data Storage
;
; Unitialized data last (does not contribute to .COM file size)
;
LINE:	ds	LINLEN+1	; Listing line buffer (follow TOTALS)
	ds	35*2		; Program stack (25 levels)
STACK	equ	$		; (Too small will only garbage listing)
TOTS	equ	$		; Start of listing totals
TFILES:	ds	2		;  Total files processed
TLEN:	ds	4		;  Total uncompressed bytes
TDISK:	ds	2		;  Total 1K disk blocks
TSIZE:	ds	4		;  Total compressed bytes
TCRC:	ds	2		;  Total of all CRC values
LINCT:	ds	1		; Line count for file typeout
ARKFLG:	ds	1		; Default file type flag (allows .ARC)
OpPFlg:	ds	1		; Printer output flag
OpCFlg:	ds	1		; Check archive validity flag
TOTC	equ	$-TOTS		; Count of bytes to clear
WHEEL:	ds	2		; Address of "wheel" byte (this pointer
				;  is now filled in by INIT routine
CDate:	ds	15		; CP/M universal date string
InUsr:	ds	1		; Input file user code
OutUsr:	ds	1		; Output file user code
GETPTR:	ds	2		; Input buffer pointer
OpEFlg:	ds	1		; Erase without asking flag
NoLPS:	ds	1		; Number of lines on screen
LPSCT:	ds	1		; Lines per screen counter
LBLKSZ:	ds	1		; Disk allocation block size for listing
TNAME:	ds	11		; Test pattern for selecting file names
OFCB:	ds	@FCBSZ		; Output file FCB
IFCB	equ	DFCB		; Input file FCB (currently using default)
HDRBUF	equ	$		; Archive file header buffer...
VER:	ds	1		; Header version no. (stowage type)
NAME:	ds	13		; Name string (NUL-terminated)
SIZE:	ds	4		; Compressed bytes
DATE:	ds	2		; Creation date } reversed, normal order
TIME:	ds	2		; Creation time } is time/date
CRC:	ds	2		; Cyclic check of uncompressed file
LEN:	ds	4		; Uncompressed bytes (version > 1)
HDRSIZ	equ	$-HDRBUF	; Header size (4 less if version = 1)
MINMEM	equ	$-1		; Min memory limit (no file output)
; Data for file output processing only
				; Following order required:
BUFPAG:	ds	1		;  Output buffer start page
BUFLIM:	ds	1		;  Output buffer limit page
				; Following order required:
CODES:	ds	1		;  Code count for crunched input
BITSAV:	ds	1		;  Bits save for crunched input
BITS:	ds	1		;  Bit count for crunched input
STRCT:	ds	2		; No. entries in crunched string table
; Tables and buffers for file output (All of the following must be page-
; aligned)
$D	defl	($+255) and 0FF00H ; Align to page boundary
CRCTAB	equ	$D		; CRC lookup table (256 2-byte values)
CRCTSZ	equ	256*2
BUFF	equ	CRCTAB+CRCTSZ	; Output buff for non-squeezed/crunched
				; or:
TREE	equ	BUFF		; 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	BUFF		; 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!
;
	end