; unc.azm
; xlate2 translation of unc.mac to z80mr & z1 format
; orig  09-09-87
; rev   11-30-87
; v2.5  02-14-88
;
; QL v2.5 changes: MEMTOP (top of memory) is retreived from previously
; defined variable "BDOSBASE" rather than reading directly from 0006H.
; Also, all data has been moved to QL's DSEG data area, where it should be.
;
;  unc & uncrel uncrunch module'
;  original version by steven greenberg.  revised by c.b. falconer
;  QL specific version re-revised by steven greenberg
;
;	copyright (c) 86/11/24 by
;	steven greenberg  201-670-8724
;	and c.b. falconer  203-281-1438.
;	may be reproduced for non-profit use only.
;
; error codes (0 for no error)
VERSION	EQU	1		; Newer uncrunch version required
ISNOTCR	EQU	2		; File is not crunched
FOULED	EQU	3		; File is fouled
MEMORY	EQU	4		; Memory or stack overflow

; move right n columns, same row

	 IF	M80

RIGHT	 MACRO	N		; Macro syntax for m80 / z80asm
	LD	A,H
	ADD	A,&N*10H
	LD	H,A
	 ENDM

	 ELSE
RIGHT	 MACRO	#N		; Macro syntax for z80mr / z1
	LD	A,H
	ADD	A,#N*10H
	LD	H,A
	 ENDM

	 ENDIF			; Not m80

SIGREV	EQU	20H		; Significant revision level
IMPRED	EQU	07FFFH		; Impossible pred, can never be matched
NOPRED	EQU	0FFFFH		; No predecessor code
VACANT	EQU	080H		; Value for a vacant entry
GUARD	EQU	07FH		; Protect table entry from use
ESCAPE	EQU	090H		; Repeated byte encoding
;
; for version 2 algorithm
INITW	EQU	9		; Initial cell width
MAXWIDE	EQU	12		; Max width of cells
TBLSIZE	EQU	5003
;
; version 2 special codes
EOFCOD	EQU	0100H
RSTCOD	EQU	0101H		; Adaptive reset signal
NULCOD	EQU	0102H		; Nop
SPRCOD	EQU	0103H		; Spare for future use
;
; Following are lo-bytes of above, expressed in a manner generically accept-
; able to a variety of assemblers. Eqiv to "LO(x)" or  "x AND 0FFH", etc.
;
LO_EOFCOD EQU	EOFCOD-256*(EOFCOD/256)
LO_RSTCOD EQU	RSTCOD-256*(RSTCOD/256)
LO_NULCOD EQU	NULCOD-256*(NULCOD/256)
LO_SPRCOD EQU	SPRCOD-256*(SPRCOD/256)
;
N01	EQU	1
N02	EQU	2
N08	EQU	8
N0F	EQU	000FH
N10	EQU	0010H
N14	EQU	0014H
N20	EQU	0020H
N28	EQU	0028H
N30	EQU	0030H
NDF	EQU	00DFH
NFE	EQU	00FEH
NFF	EQU	00FFH
T0FFF	EQU	0FFFH
T1000	EQU	1000H
T2000	EQU	2000H
T2800	EQU	2800H
T4000	EQU	4000H

;..............................................................................
;
; Various error exits
;
XNOTCR:	LD	A,ISNOTCR
	JR	ERROR

XSTKOV:	LD	A,MEMORY
	JR	ERROR

XBADF:	LD	A,FOULED
	JR	ERROR

XNEWV:	LD	A,VERSION

ERROR:	SCF

EXIT:	LD	HL,(SPSAVE)
	LD	SP,HL
	RET

EXITOK:	XOR	A
	JR	EXIT

; entry here if application has already read the header, and
; validated the initial id bytes.  this avoids rewinding the file.
; the next input byte must be the revision level.
UNC:	CALL	MALLOC		; Returns hl = new stack
	JR	C,XSTKOV
	LD	SP,HL		; Ok, now switch stacks
	JR	UNCRB
;
; set up memory allocation.  base pointer in hl
; carry if insufficient space (stack overflow incipient)
MALLOC:	EX	DE,HL
	LD	HL,2		; Allow for call malloc
	ADD	HL,SP
	LD	(SPSAVE),HL	; Save return from main
	LD	HL,255
	ADD	HL,DE		; Round up to page boundary
	LD	L,0
	LD	(@TABLE),HL
	LD	A,N30		; '0'
	ADD	A,H
	LD	H,A
	LD	(XLATBL),HL	; For version 2 system
	LD	A,N28		; '('
	ADD	A,H
	LD	H,A
	PUSH	HL
	CPL
	LD	H,A		; 4 less bytes than z80 coding
	INC	H		; L was zero
	LD	(STKLIM),HL
	POP	HL
	LD	A,H
	ADD	A,N08		; Proposed stack page
	LD	H,A		; Check stack page a suitable
	LD	L,0
	EX	DE,HL		; Check memory against memtop
	LD	HL,(BDOSBASE)	; (was MEMTOP)
	LD	A,H		; @table thru newstack
	SUB	D		; (can exit because stack saved)
	RET	C		; Not enough system memory
	LD	A,(SPSAVE+1)
	LD	HL,(@TABLE)
	CP	H
	JR	C,STKCK1	; Input stack below table, ok
	LD	H,A		; Input stack page
	LD	A,D		; New stack page
	CP	H
STKCK1:	CCF
	EX	DE,HL
	RET			; With carry if stack overflow

;..............................................................................
;
UNCRB:	CALL	INIT		; Variables etc
	CALL	GETBYT		; Ignore revision level
	CALL	GETBYT		; Significant revision level
	PUSH	AF
	CALL	GETBYT		; Ignore checksum flag
	CALL	GETBYT		; And spare byte
	POP	AF
	CP	SIGREV+1
	JR	NC,XNEWV	; Need newer version
	CP	SIGREV
	JR	NC,UNCRC	; Ver 20 uncrunching
;	"	"
; ver 10 uncrunching
	CALL	UNC1I
	JR	UNC1

UNCRC:	CALL	UNC2I		; Ver. 2, initialize tables
	JR	UNC2
;
; version 10 uncrunching initialize. returns de := nopred

UNC1I:	LD	HL,T0FFF
	LD	(TROOM),HL
	CALL	CLRMEM
	LD	A,12
	LD	(WIDTH),A	; Ver 10 tokens are 12 bits
	XOR	A
	LD	(KIND),A	; 0 for version 10 operation
;	"	"
; initialize atomic entries. set de := nopred
ATOMS:	XOR	A
	LD	HL,NOPRED
ATOMS1:	PUSH	AF
	PUSH	HL
	CALL	ENTERX		; Make entry { hl, a }
	POP	HL
	POP	AF
	INC	A
	JR	NZ,ATOMS1
	EX	DE,HL		; De := nopred
	RET
;
; version 20 setup.  returns de := nopred
UNC2I:	CALL	CLRTBL
	LD	A,1
	LD	(KIND),A	; Version 20 signal
	LD	A,N20		; Force non-bumpable atomic entries
	LD	(FFFLAG),A
	CALL	ATOMS		; Init atomic entries
	LD	B,LO_SPRCOD+1	;
UNC2I2:	PUSH	BC
	LD	HL,IMPRED	; Impossible pred
	XOR	A
	CALL	ENTERX		; Reserve eof thru sprcod
	POP	BC		; Unmatchable and unbumpable
	DEC	B
	JR	NZ,UNC2I2	;
	XOR	A
	LD	(FFFLAG),A	; Reset flag
	LD	H,A
	LD	L,A
	LD	(TROOM),HL	; Re-used as re-assignment counter
	LD	DE,NOPRED
	RET
;
; ver 10 uncrunching loop
UNC1:	EX	DE,HL
	LD	(LASTPR),HL
	CALL	GETOK		; New 12 bit code to de
	JP	C,EXITOK	; Eof or eof node
	PUSH	DE
	CALL	DECODE
	LD	HL,ENTFLG
	LD	A,(HL)
	LD	(HL),0
	OR	A
	CALL	Z,ENTLAST	; Make new table entry if not done
	POP	DE
	LD	A,(FULFLG)
	OR	A
	JR	Z,UNC1		; Continue
;	"	"
; speed up when table full, no more entries need be made/checked
UNC1B:	CALL	GETOK
	JP	C,EXITOK
	PUSH	DE
	CALL	DECODE
	POP	DE
	JR	UNC1B		; Continue
;
; version 2 uncrunching
UNC2:	EX	DE,HL
	LD	(LASTPR),HL
	CALL	GETKN
	JR	C,UNC2C		; Eof or reset etc.
	PUSH	DE
	CALL	DECODE
	LD	HL,ENTFLG
	LD	A,(HL)
	LD	(HL),0
	OR	A
	CALL	Z,ENTLAST	; If not made, then make entry
	POP	DE
	LD	A,(FULFLG)
	OR	A
	JR	Z,UNC2		; Adaptive system reset
	CP	NFE		; When this becomes 0ffh all done. first
	JR	NZ,UNC2B	; It becomes 0feh, when one more loop
	INC	A		; Is required, and set it to 0ffh.
	LD	(FULFLG),A
	JR	UNC2		; Do the extra loop

; table is full.  no new entries needed
UNC2B:	EX	DE,HL
	LD	(LASTPR),HL
	CALL	GETKN
	JR	C,UNC2C		; Eof etc
	PUSH	DE
	CALL	DECODE
	LD	HL,(LASTPR)
	LD	A,(CHAR)
	CALL	RECOD		; Check for code re-assignment
	POP	DE
	JR	UNC2B
;
; here for input codes in range 100h..103h (eof..sprcod).
UNC2C:	LD	A,E		; Special code, (eof or adaptive reset)
	CP	LO_EOFCOD
	JP	Z,EXITOK	; Done
	CP	LO_RSTCOD
	JP	NZ,XNOTCR
;	"	"
; adaptive reset
	XOR	A
	LD	H,A
	LD	L,A
	LD	(CODES),HL	; Init current code to 0
	LD	(FULFLG),A	; Clear
	CALL	UNC2I
	LD	A,INITW
	LD	(WIDTH),A	; Reset input code width
	LD	A,N02
	LD	(TRGMSK),A
	LD	A,N01
	LD	(ENTFLG),A	; 1st entry always a special case
	JR	UNC2
;
; var b : byte; (* global *)
;
; procedure decode(x : index);
;
;   var ix : index;	(* index is a record *)
;
;   begin (* decode *)
;   ix := lookup(x);
;   if ix.pred = nil then enter(x, b);
;   if ix.pred = nopred then b := ix.byte
;   else decode(ix.pred);
;   send(ix.byte);
;   end; (* decode *)
;
; the char associated with the bottomost recursion level is saved in
; "char" and is used later to make the next table entry.
;
; the code at "ugly" has to do with a peculiar string sequence where
; the encode "knows" about a string before the decoder so the decoder
; has to make an emergency entry.  fortunately there is enough inform-
; ation available to do this.  it has been shown that this case is
; unique and that the assumptions are valid.  to understand the lzw
; algorithm the "ugly" code may be ignored.
;
; universal decoder
; a,f,b,c,d,e,h,l
DECODE:	LD	A,(KIND)
	OR	A
	JR	Z,DCDA		; Version 1, no setup needed
	PUSH	DE
	EX	DE,HL
	LD	A,(@TABLE+1)
	ADD	A,H
	LD	H,A		; Convert code to table adr.
	LD	A,(HL)
	OR	020H		; Mark referenced (not bumpable)
	LD	(HL),A
	POP	DE
;	"	"
; decode/output the index in de. recursive
; a,f,b,c,d,e,h,l
DCDA:	LD	HL,(STKLIM)
	ADD	HL,SP
	JP	NC,XSTKOV	; Stack overflow
	LD	A,(@TABLE+1)	; Convert index de to address hl
	ADD	A,D
	LD	H,A
	LD	L,E
	LD	A,(HL)
	AND	NDF		; (for 2 only)
	CP	VACANT
	JR	NZ,DCDA1	; Not vacant, normal case
;	"	"
; the "ugly" exception.  term due to k. williams
	LD	A,N01
	LD	(ENTFLG),A
	PUSH	HL
	LD	A,N20		; (for 2 only)
	LD	(FFFLAG),A
	CALL	ENTLAST		; Make emergency entry
	XOR	A
	LD	(FFFLAG),A	; (for 2 only)
	POP	HL
	LD	A,(HL)
	CP	VACANT
	JP	Z,XBADF		; If vacant file is invalid
;	"	"
DCDA1:	LD	D,(HL)		; Get "pred" (hi)
	RIGHT	1		; Move to "pred" (lo)
	LD	E,(HL)		; Get it. if msb of hi byte is set value
	LD	A,D		; Must be ff (nopred) because not 80h
	AND	0DFH		; ~20h
	JP	M,DECODX	; Nopred, terminate recursion
	LD	D,A		; (for 2, remove any accessed flag)
	PUSH	HL
	CALL	DCDA		; Recursive
	POP	HL
	RIGHT	1		; Move ahead to "suffix" byte
	LD	A,(HL)
	JR	SEND		; Output suffix byte & exit
;
; exit from decoding recursion.  unloads all the stacked items.
DECODX:	RIGHT	1		; Move ahead to "suffix" byte
	LD	A,(HL)		; Get & save as 1st char of decoded
	LD	(CHAR),A	; String.  used later to make a new
;	"	"		   table entry.  send & exit
; send char with repeat expansion etc.
; a,f,b,c,h,l
SEND:	LD	C,A		; Output char
	LD	HL,(OUTFLG)
	INC	H
	DEC	H
	JR	NZ,SEND2	; Repeat flag set
	CP	ESCAPE
	JR	Z,SEND1		; Escape char, set flag
	LD	L,A		; Save char for possible repeat coming
	DEC	H		; Cancel coming inr, not repeat
	CALL	OUT
SEND1:	INC	H		; Set repeat flag
	LD	(OUTFLG),HL
	RET

SEND2:	LD	H,0		; Clear repeat flag
	LD	(OUTFLG),HL	; Save result (with l = repeat char)
	OR	A
	JR	Z,SEND4		; Escape 0 represents escape
	DEC	A
	RET	Z		; Take care of repeat = 1
	LD	H,A		; Set repeat count
	LD	A,L		; Repeaat char
SEND3:	CALL	OUT
	DEC	H
	JR	NZ,SEND3
	RET

SEND4:	LD	A,ESCAPE
	JP	OUT
;
; enter lastpr/char into table
; a,f,b,c,d,e,h,l
ENTLAST:
	LD	HL,(LASTPR)
	LD	A,(CHAR)
;	"	"
; enter { <pred>, <suffix> } into table, passed in {hl, a} regs.
; a,f,b,c,d,e,h,l
ENTERX:	LD	B,A
	LD	A,(KIND)
	OR	A
	LD	A,B
	JR	NZ,ENT2X	; Version 2 decoding
;	"	"		  else version 1 decoding
; enter { <pred>, <suffix> } into table, passed in {hl, a} regs.
; a,f,b,c,d,e,h,l
ENT1X:	PUSH	AF
	PUSH	HL
	CALL	MIDSQ		; Hash index into al
	LD	H,A
	LD	A,(@TABLE+1)	; Page address
	ADD	A,H
	LD	H,A		; Into address
	POP	DE		; Pred
	POP	AF		; Suffix
	LD	C,A
;	"	"
ENT1X1:	LD	B,H		; Check for match
	LD	A,(HL)
	CP	VACANT
	JR	Z,ENT1X3	; Entry does not exist, make it
	RIGHT	3		; Move to link column
	LD	A,(HL)		; Link(hi)
	OR	A
	JR	Z,ENT1X2	; No link
	LD	B,A		; Save
	RIGHT	1		; Move to link(lo) field
	LD	L,(HL)
	LD	H,B		; Hl := link address
	JR	ENT1X1		; And repeat

ENT1X2:	LD	H,B		; Restore h to left hand column
	CALL	FFREE		; Find new spot and link in. returns
;	"	"		   hl pointing to new entry.
ENT1X3:	CALL	LINK		; Make the entry.  pred(hi)
	RIGHT	1
	LD	(HL),C		; Suffix
	LD	HL,(TROOM)
	DEC	HL
	LD	(TROOM),HL
	LD	A,H
	OR	L
	RET	NZ		; Not full
	DEC	A
	LD	(FULFLG),A	; Else set full flag
	RET
;
; link entry de at location hl^
LINK:	LD	(HL),D		; High
	RIGHT	1
	LD	(HL),E		; Lo
	RET
;
; version 2 table entry
ENT2X:	PUSH	AF
	PUSH	HL
	CALL	TBLADR		; To physical loc only, affects nothing
	POP	DE		; And check width etc??
	LD	HL,(CODES)
	LD	A,(@TABLE+1)
	ADD	A,H
	LD	H,A		; Convert to address
;	"	"
; entry is made here, but normally flagged as "unreferenced" (until
; received by decode).	until then entries are "bumpable".  if ffflag
; is 020h the reference is flagged now, to protect atomic entries and
; wswsw string emergency entries (from decode, despite not received)
	LD	A,(FFFLAG)
	OR	D		; May set "referenced" bit
	LD	(HL),A		; Pred(hi)
	RIGHT	1
	LD	(HL),E		; Pred(lo)
	RIGHT	1
	POP	AF
	LD	(HL),A		; Suffix
	LD	HL,(CODES)	; Advance entry counter
	INC	HL
	LD	(CODES),HL
	INC	HL		; Allow for crunch/uncrunch skew delay
	LD	A,(TRGMSK)	; See if new code length needed
	CP	H
	RET	NZ
	RLA			; Carry was clear.  change to new length
	LD	(TRGMSK),A	; New target mask
	LD	A,(WIDTH)
	INC	A
	CP	MAXWIDE+1
	JR	Z,ENT2X1	; Mark table full
	LD	(WIDTH),A	; Advance to new width
	RET

ENT2X1:	LD	A,NFE		; Mark table full, at max width
	LD	(FULFLG),A
	RET
;
CLRMEM:	LD	HL,(@TABLE)
	LD	(HL),GUARD	; Disallow entry #0
	INC	HL		; (used, but unmatchable)
	LD	E,VACANT
	LD	BC,T1000	; Mark entries vacant
	CALL	FILL
	LD	BC,T4000
;	"	"
; fill hl^ for bc with zero
FILLZ:	LD	E,0
;	"	"
; fill hl^ for bc with e
FILL:	LD	(HL),E
	INC	HL
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,FILL
	RET
;
; find a free entry in the event of a hash collision.  algorithm is to
; first add 101 (decimal) to the current (end-of-chain) entry.	if
; that entry is not free keep adding 1.  when a free entry is found
; the link pointer of the original entry is set to the found entry.
;
; called with adr of an entry in hl, returns hl = adr of new entry.
; a,f,h,l
FFREE:	PUSH	BC
	PUSH	DE
	PUSH	HL		; Save pointer to old entry for update
	LD	A,L
	ADD	A,101		; Relatively prime to table size
	LD	L,A
	JR	NC,FFREE1	; No carry, thus no wrap
	INC	H
	LD	A,(@TABLE+1)
	ADD	A,N10
	CP	H
	JR	NZ,FFREE1	; No wrap-around
	LD	A,(@TABLE+1)	; Set to table bottom
	LD	H,A
FFREE1:	LD	A,(@TABLE+1)	; Compute # of remaining entries,
	ADD	A,N0F		; Counting up (last entry + 1
	SUB	H		; - current entry)
	LD	B,A
	LD	A,L		; As far as the low byte is concerned
	CPL			; We know we are subtracting from 0.
	INC	A
	JR	NZ,FFREE2
	INC	B
FFREE2:	LD	C,A		; Result in bc
	LD	D,H		; Keep copy
	LD	E,L
	CALL	CMPM		; Search for empty entry
	JR	NC,FFREE3	; Found vacant entry
	LD	HL,(@TABLE)	; Else wrap to start of table
	LD	A,(@TABLE+1)
	LD	B,A
	LD	A,D
	SUB	B		; (adr to index# conversion)
	LD	B,A
	LD	C,E		; Target value
	CALL	CMPM		; Continue search
	JP	C,XNOTCR	; Not found.  should not occur
FFREE3:	EX	DE,HL
	POP	HL		; Original pointer to link
	RIGHT	3		; Move to link(hi) field
	CALL	LINK		; Link to new entry
	EX	DE,HL		; Returned in hl
	POP	DE
	POP	BC
	RET
;
; search for vacant entry from hl^ up. carry if not found
; carry clear if found when hl points to found entry
; a,f,b,c,h,l
CMPM:	LD	A,(HL)
	CP	VACANT
	RET	Z
	INC	HL
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,CMPM
	SCF			; Signal not found
	RET
;
; return the mid-square of number of "pred" + "suffix" (actually the
; mid-square of # or 0800h). entry a = suffix, hl = pred.  returns
; result in a|l (not hl), ready to add a table offset.
;
; mid-square means the midddle n bits of the square of an n-bit num.
; here n is 12.  results accumulate in a 16 bit register, with
; extraneous information overflowing off both ends of the register.
;
; hash via mid-square of 12 bit input or'd with 800h.
; input is hl + a.  output in al registers.
; note anomalous results for input out of range.  special handling
; since really needs to operate on 13 bit words to match the original.
; the algorithm is due to robert a. freed.  this runs on 8080s, takes
; the identical code space as mr. freeds z80 implementation, and has
; miniscule or no average performance penalty.	by c.b. falconer.
;
; entry: a = suffix; hl = pred.  exit al = midsq
; a,f,b,c,d,e,h,l
MIDSQ:	ADD	A,L		; Hl := hl + a
	LD	L,A		; Max result fffh+0ffh=010feh
	ADC	A,H		; (normal, except special case)
	SUB	L
	LD	D,A		; Save for special test
	OR	8		; Or with 800h.  max 18feh
; following should be 0fh, but modified to agree with original
	AND	1FH		; Mask to 13 bits. max 1fffh
	RRA
	LD	H,A		; Max 7ffh
	LD	B,A		; M := bc := hl := input div 2
	LD	A,L		; Using n*n = 4 * (m * m)     (n even)
	RRA			; Or	      4 * m * (m+1)+1 (n odd)
	LD	L,A		; And any final "1" gets discarded.
	LD	C,A
	JR	NC,MIDSQ1	; Even, use m
	INC	HL		; Hl := m+1
;	"	"
; special case test, input = 0ffffh+0 must hash to 800h
; from initial 1 byte string prefix = nopred, suffix = 0.
	LD	A,D
	OR	A		; Did input have high bit?
	LD	A,H		; Holds 800h in this case
	RRA			; Because using 13, not 12 bits
	RET	M		; Yes, return 0800h
;	"	"
; multiplication. hl := bc * hl (12 lo bits of hl only)
MIDSQ1:	LD	A,12		; Bits in m * m' multiplication
	ADD	HL,HL
	ADD	HL,HL		; Reposition multiplier
	ADD	HL,HL
	ADD	HL,HL		; Using 12, not 16 bit multiply
	EX	DE,HL		; Multiplier to de
	LD	L,0		; Clear necessary portion
MIDSQ2:	ADD	HL,HL		; Left shift accum. main loop.
	EX	DE,HL		; Discarding overflow past 16 bits
	ADD	HL,HL		; Left shift multiplier
	EX	DE,HL
	JR	NC,MIDSQ3	; Multiplier bit = 0
	ADD	HL,BC		; =1, add in
MIDSQ3:	DEC	A
	JR	NZ,MIDSQ2	; More bits
	ADD	HL,HL		; Reposition 12 bit result
	RLA
	ADD	HL,HL		; Shift 4 bits to a
	RLA
	ADD	HL,HL
	RLA
	ADD	HL,HL
	RLA
	LD	L,H		; Move down low 8 bits of result
	AND	0FH		; Mask off. result in a & l
	RET
;
; get input token, variable width.  check nops etc
; carry for eof
; a,f,b,c,d,e
GETKN:	CALL	GETOK
	LD	A,D
	DEC	A
	AND	A		; Clear any carry
	RET	NZ		; Code not 01xx
	LD	A,E
	CP	LO_SPRCOD+1	; Codes used
	RET	NC
	CP	LO_NULCOD	; Lo byte of "nulcod"
	JR	NC,GETKN	; Ignore null and spare codes, nop
	RET			; Must be rstcod or eof, cy set
;
; get input token, variable width
; a,f,b,c,d,e
GETOK:	LD	DE,0
	LD	A,(WIDTH)
	LD	B,A
	LD	A,(LFTOVR)
	LD	C,A
GETOK1:	LD	A,C
	ADD	A,A		; Bit to cy, flags on remainder
	CALL	Z,MOREIN	; Lftovr was empty, get more
	LD	C,A		; And keep the remainder
	LD	A,E
	RLA
	LD	E,A		; Shift into de
	LD	A,D
	RLA
	LD	D,A
	DEC	B
	JR	NZ,GETOK1	; More bits to unpack
	LD	A,C
	LD	(LFTOVR),A	; Save any remainder
	LD	A,D
	OR	E
	RET	NZ
	SCF			; Carry for 0 value (eof)
	RET
;
; subroutine for getok.  next input byte positioned etc.
MOREIN:	CALL	GETBYT
	SCF
	RLA			; Bit to carry, set end marker
	RET
;
; clear version 2 tables ??
CLRTBL:	LD	HL,(@TABLE)	; 4096 rows * 3 cols, main table
	LD	BC,T1000
	LD	E,VACANT
	CALL	FILL
	LD	BC,T2000
	CALL	FILLZ
	LD	HL,(XLATBL)	; Physical to logical translation table
	LD	(HL),GUARD
	INC	HL
	LD	BC,T2800	; 1400h * 2 entries
	LD	E,VACANT
	JP	FILL
;
; figure out what physical loc'n the cruncher put its entry at by
; reproducing the hashing process.  insert the entry # into the
; corresponding physical location in xlatbl.
TBLADR:	LD	B,A
	CALL	HASH		; To hl
TBLAD1:	LD	C,H
	LD	A,(HL)
	CP	VACANT
	JR	Z,TBLAD2	; No entry, make it
	CALL	REHASH
	JR	TBLAD1

TBLAD2:	EX	DE,HL
	LD	HL,(CODES)	; Logical entry #
	EX	DE,HL
	LD	(HL),D
	LD	A,H		; Right 1 for this table
	ADD	A,N14
	LD	H,A
	LD	(HL),E
	LD	A,(XLATBL+1)
	LD	H,A
	LD	A,C
	SUB	H
	LD	H,A
	RET
;
; rehash
REHASH:	EX	DE,HL
	LD	HL,(NEXTX)	; Displacement from hash
	ADD	HL,DE
	LD	A,(XLATBL+1)	; Page address
	LD	D,A
	LD	A,H
	CP	D
	RET	NC
	LD	DE,TBLSIZE
	ADD	HL,DE
	RET
;
; check for code reassignment?
RECOD:	LD	B,A
	LD	A,NFF
	LD	(AVAIL+1),A
	LD	A,B
	CALL	HASH		; To hl
RECOD1:	LD	C,H
	LD	A,(HL)
	CP	VACANT
	JR	Z,RECOD4	; End chain. try make entry (elsewhere)
	LD	A,(AVAIL+1)
	CP	NFF
	JR	NZ,RECOD3	; Have an entry
	PUSH	HL		; Physical table pointer
	LD	D,(HL)		; Entry # (hi)
	LD	A,H
	ADD	A,N14		; Right 1
	LD	H,A
	LD	L,(HL)		; Entry # (lo)
	LD	A,(@TABLE+1)	; Convert to addres
	ADD	A,D
	LD	H,A
	LD	A,(HL)
	AND	020H
	JR	NZ,RECOD2	; Not bumpable, try next
	LD	(AVAIL),HL	; Save resulting entry # for later use
RECOD2:	POP	HL
RECOD3:	CALL	REHASH		; To next link in chain
	JR	RECOD1

RECOD4:	LD	HL,(AVAIL)	; Reassign the entry pointed to by avail
	LD	A,H		; (if any), redefine "last pred entrd"
	CP	NFF		; And "last suffix" vars.
	RET	Z		; None available
	EX	DE,HL
	LD	HL,(TROOM)
	INC	HL
	LD	(TROOM),HL	; Keep track of codes re-assigned
	LD	HL,(LASTPR)
	EX	DE,HL
	LD	A,(CHAR)
	LD	B,A
	CALL	LINK
	RIGHT	1
	LD	(HL),B
;	"	"
HASH:	LD	E,L
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	ADD	HL,HL
	XOR	H
	LD	L,A
	LD	A,E
	AND	N0F
	LD	H,A
	LD	A,(XLATBL+1)	; Add in table offset
	ADD	A,H
	LD	H,A
	INC	HL		; Eliminate 0 case
	PUSH	HL
	EX	DE,HL
	LD	HL,(TBLTOP)
	ADD	HL,DE		; Make index dependant, not address
	LD	(NEXTX),HL	; Rehash value, -ve no.
	POP	HL
	RET

; initialize variables, pointers, limits
INIT:	LD	HL,(XLATBL)	; Hi byte is 0
	LD	DE,-TBLSIZE
	LD	A,E
	SUB	L
	LD	L,A
	LD	A,D
	SBC	A,H
	LD	H,A
	LD	(TBLTOP),HL	; -(xlatbl + tblsize)
	LD	HL,ITABLE
	LD	DE,FULFLG	; Copy the "shadow"
	LD	BC,ITBSIZE
	LDIR
	RET

; initializing table ("shadow") for data area
ITABLE:	DEFB	0
	DEFW	NOPRED
	DEFB	1
	DEFW	0
	DEFB	VACANT
	DEFB	INITW		; Initial cell width
	DEFB	2
	DEFW	0
ITBSIZE	EQU	$-ITABLE
;
;	end of  UNC.AZM include file