(* ETH Oberon, Copyright 2001 ETH Zuerich Institut fuer Computersysteme, ETH Zentrum, CH-8092 Zuerich.
Refer to the "General ETH Oberon System Source License" contract available at: http://www.oberon.ethz.ch/ *)

MODULE ZlibDeflate;	(** Stefan Walthert  **)
(** AUTHOR "swalthert"; PURPOSE "Zlib compression"; *)

	(**
		Compression of byte streams with deflate algorithm
	**)

	(*
		01.04.2001 - fixed bug in Deflate (condition before 4th RETURN statement:
							.. & (flush # BufError) THEN .. instead of .. & (flush # Finish) THEN ..
	*)

IMPORT
	SYSTEM, Zlib, ZlibBuffers;

CONST
	(** Result codes for compression/decompression functions **)
	Ok* = Zlib.Ok; StreamEnd* = Zlib.StreamEnd; (** regular termination **)
	StreamError* = Zlib.StreamError;DataError* = Zlib.DataError; MemError* = Zlib.MemError; BufError* = Zlib.BufError; (** errors **)

	(** Flush values **)
	NoFlush* = Zlib.NoFlush; PartialFlush = Zlib.PartialFlush; SyncFlush* = Zlib.SyncFlush; FullFlush* = Zlib.FullFlush; Finish* = Zlib.Finish;

	(** compression levels **)
	DefaultCompression* = Zlib.DefaultCompression; NoCompression* = Zlib.NoCompression;
	BestSpeed* = Zlib.BestSpeed; BestCompression* = Zlib.BestCompression;

	(** compression strategies **)
	DefaultStrategy* = Zlib.DefaultStrategy; Filtered* = Zlib.Filtered; HuffmanOnly* = Zlib.HuffmanOnly;

	(** data type **)
	Binary* = Zlib.Binary; Ascii* = Zlib.Ascii; Unknown* = Zlib.Unknown;

	(* stream states *)
	InitState = 1; BusyState = 2; FinishState = 3;

	(* block state *)
	NeedMore = 1; BlockDone = 2; FinishStarted = 3; FinishDone = 4;

	StoredBlock = 0; StaticTrees = 1; DynamicTrees = 2;	(* block types *)
	Deflated = 8;	(* compression method (by coincidence the only one supported..) *)
	PresetDict = 20H;	(* flag indicating use of a preset dictionary *)

	(* Huffman trees *)
	LengthCodes = 29; Literals = 256; LitLenCodes = Literals + 1 + LengthCodes; DistCodes = 30; BitCodes = 19;
	HeapSize = 2 * LitLenCodes + 1; MaxBits = 15; MaxBitLenBits = 7; DistCodeLen = 512; EndBlock = 256; BitBufSize = 16;
	Rep3To6 = 16; RepZero3To10 = 17; RepZero11To138 = 18;

	(* window and matches *)
	WindowBits = 15; WindowSize = ASH(1, WindowBits);	(* always use 32k buffer *)
	MinMatch = 3; MaxMatch = 258;
	MinLookAhead = MinMatch + MaxMatch + 1; MaxDist = WindowSize - MinLookAhead;
	TooFar = 4096;	(* matches of length MinMatch are discarded if their distance exceeds this *)
	MemLevel = 8;	(* constant memory level *)
	HashBits = MemLevel + 7; HashSize = ASH(1, HashBits);	(* implies constant number of hash bits *)
	HashShift = (HashBits + (MinMatch - 1)) DIV MinMatch;	(* MinMatch bytes should have effect on hash code *)
	LitBufSize = ASH(1, MemLevel + 6);	(* number of elements in literal/distance buffers *)
	PendingBufSize = ASH(LitBufSize, 2);	(* use 64k pending buffer *)

TYPE
	(* Huffman trees *)
	Node = RECORD
		freqOrCode: INTEGER;	(* frequency count / bit string *)
		dadOrLen: INTEGER	(* father node on Huffman tree / length of bit string *)
	END;
	Nodes = POINTER TO ARRAY OF Node;

	Bits = POINTER TO ARRAY OF INTEGER;

	StaticTree = RECORD
		node: Nodes;
		bits: Bits;	(* extra bits for each code *)
		base: INTEGER;	(* base index for Bits *)
		elems: INTEGER;	(* max number of elements in the tree *)
		maxLength: INTEGER	(* max bit length for the codes *)
	END;

	Tree = RECORD
		node: Nodes;	(* dynamic tree *)
		maxCode: INTEGER;	(* largest code with non-zero frequency *)
		static: StaticTree	(* corresponding static tree *)
	END;

	Window = ARRAY 2 * WindowSize OF CHAR;	(* double size to keep full dictionary at all times; input is read into upper half *)

	PendingBuffer = RECORD
		buf: POINTER TO ARRAY PendingBufSize OF CHAR;		(* memory for pending buffer *)
		beg: LONGINT;		(* next pending byte to write to output buffer *)
		end: LONGINT		(* next pending byte in pending buffer *)
	END;

	(** deflate stream **)
	Stream* = RECORD
		in*, out*: ZlibBuffers.Buffer;
		res-: LONGINT;		(** result of last operation **)
		level-: SHORTINT;	(** compression level **)
		strategy-: SHORTINT;	(**compression strategy **)
		dataType-: SHORTINT;	(** Unknown, Binary or Ascii **)
		wrapper-: BOOLEAN;	(** if set, zlib header and checksum are generated **)
		open-: BOOLEAN;		(** if set, stream is initialized **)
		trailerDone: BOOLEAN;	(* if set, the zlib trailer has already been generated *)
		lastFlush: SHORTINT;	(* flush operation of the previous deflate call *)
		status: SHORTINT;		(* current stream state *)
		adler: LONGINT;		(* Adler32 checksum *)

		window: POINTER TO Window;	(* memory for sliding window *)
		block: LONGINT;	(* position in window where current block starts (negative if window moved) *)
		hash: LONGINT;	(* hash index of string to insert *)
		prev: POINTER TO ARRAY WindowSize OF LONGINT;	(* link to older string with same hash code (for last 32k strings) *)
		head: POINTER TO ARRAY HashSize OF LONGINT;	(* heads of hash chains for every window position *)
		string: LONGINT;	(* start of string to insert *)
		lookAhead: LONGINT;	(* number of valid bytes ahead in window *)
		match: LONGINT;	(* start of match string *)
		matchLen: LONGINT;	(* length of best match *)
		prevMatch: LONGINT;	(* start of previous match *)
		prevLen: LONGINT;	(* length of best match at previous step *)
		prevAvail: BOOLEAN;	(* set if previous match exists *)
		pend: PendingBuffer;

		(* trees *)
		ltree, dtree, btree: Tree;	(* trees for literals/lengths, distances and bit lengths *)
		lnode, dnode, bnode: Nodes;	(* corresponding nodes *)
		bitLenCount: ARRAY MaxBits + 1 OF INTEGER;	(* number of codes at each bit length for optimal tree *)
		heap: ARRAY HeapSize OF INTEGER;	(* heap used to build Huffman tree *)
		heapLen: INTEGER;	(* number of elements in the heap *)
		heapMax: INTEGER;	(* heap element of largest frequency *)
		depth: ARRAY HeapSize OF INTEGER;	(* depth of each subtree for deciding between trees of equal frequency *)
		lbuf: POINTER TO ARRAY LitBufSize OF CHAR;	(* buffer for literals/lengths *)
		dbuf: POINTER TO ARRAY LitBufSize OF INTEGER;	(* buffer for distances *)
		lastLit: LONGINT;	(* running index in lbuf *)
		buf: LONGINT;	(* bit buffer *)
		bits: INTEGER;	(* number of valid bits in bit buffer *)
		lastEobLen: INTEGER;	(* bit length of End Of Block code for last block *)
		optLen: LONGINT;	(* bit length of current block with optimal trees *)
		staticLen: LONGINT;	(* bit length of current block with static trees *)
	END;

	Compressor = PROCEDURE (VAR s: Stream; flush: SHORTINT): SHORTINT;

VAR
	ExtraLenBits, ExtraDistBits, ExtraBitBits: Bits;
	LTree, DTree, BTree: StaticTree;
	BaseLength: ARRAY LengthCodes OF INTEGER;
	BaseDist: ARRAY DistCodes OF INTEGER;
	LengthCode: ARRAY MaxMatch - MinMatch + 1 OF CHAR;
	DistCode: ARRAY DistCodeLen OF CHAR;
	BitOrder: ARRAY BitCodes OF SHORTINT;
	ConfigTable: ARRAY 10 OF RECORD
		GoodLen: INTEGER;	(* reduce lazy search above this match length *)
		MaxLazy: INTEGER;	(* do not perform lazy search above this match length *)
		NiceLen: INTEGER;	(* quit search above this match length *)
		MaxChain: INTEGER;	(* maximal number of hash entries considered *)
		Compress: Compressor;	(* block compress procedure *)
	END;


(* Put a byte c in the pending buffer *)
PROCEDURE PutChar(VAR pend: PendingBuffer; c: CHAR);
BEGIN
	pend.buf[pend.end] := c;
	INC(pend.end)
END PutChar;

(* Put the 16 LSB of b in LSB order in the pending buffer *)
PROCEDURE Put16BitsLSB(VAR pend: PendingBuffer; b: LONGINT);
BEGIN
	PutChar(pend, CHR(b MOD 100H));
	PutChar(pend, CHR((b DIV 100H) MOD 100H))
END Put16BitsLSB;

(* Put the 16 LSB of b in MSB order in the pending buffer *)
PROCEDURE Put16BitsMSB(VAR pend: PendingBuffer; b: LONGINT);
BEGIN
	PutChar(pend, CHR((b DIV 100H) MOD 100H));
	PutChar(pend, CHR(b MOD 100H))
END Put16BitsMSB;

(* Put the 32 LSB of b in MSB order in the pending buffer *)
PROCEDURE Put32BitsMSB(VAR pend: PendingBuffer; b: LONGINT);
BEGIN
	Put16BitsMSB(pend, (b DIV 10000H) MOD 10000H);
	Put16BitsMSB(pend, b MOD 10000H)
END Put32BitsMSB;

(* Reverse the first len bits of a code, using straightforward code *)
PROCEDURE ReverseBits(code, len: INTEGER): INTEGER;
VAR
	res: INTEGER;
BEGIN
	res := 0;
	REPEAT
		res := res * 2; INC(res, code MOD 2);
		code := code DIV 2; DEC(len)
	UNTIL len = 0;
	RETURN res
END ReverseBits;

(* Send a value on a given number of bits *)
PROCEDURE SendBits(VAR stream: Stream; val: LONGINT; len: INTEGER);
BEGIN
	INC(stream.buf, ASH(val, stream.bits)); INC(stream.bits, len);
	IF stream.bits > BitBufSize THEN
		Put16BitsLSB(stream.pend, stream.buf);
		stream.buf := SYSTEM.LSH(stream.buf, -BitBufSize); DEC(stream.bits, BitBufSize)
	END
END SendBits;

(* Send a code of the given node. c and node must not have side effects *)
PROCEDURE SendCode(VAR stream: Stream; VAR node: Node);
BEGIN
	SendBits(stream, node.freqOrCode, node.dadOrLen)
END SendCode;

(* Flush the bit buffer, keeping at most 7 bits in it *)
PROCEDURE FlushBits(VAR stream: Stream);
BEGIN
	IF stream.bits = BitBufSize THEN
		Put16BitsLSB(stream.pend, stream.buf);
		stream.buf := 0; stream.bits := 0
	ELSIF stream.bits >= 8 THEN
		PutChar(stream.pend, CHR(stream.buf));
		stream.buf := SYSTEM.LSH(stream.buf, -8); DEC(stream.bits, 8)
	END
END FlushBits;

(* Flush as much pending output as possible. *)
PROCEDURE FlushPending(VAR pend: PendingBuffer; VAR out: ZlibBuffers.Buffer);
VAR
	len: LONGINT;
BEGIN
	len := pend.end - pend.beg;
	IF len > out.avail THEN len := out.avail END;
	IF len > 0 THEN
		ZlibBuffers.WriteBytes(out, pend.buf^, pend.beg, len);
		INC(pend.beg, len);
		IF pend.beg = pend.end THEN
			pend.beg := 0; pend.end := 0
		END
	END
END FlushPending;

(* Flush the bit buffer and align the output on a byte boundary *)
PROCEDURE WindupBits(VAR stream: Stream);
BEGIN
	IF stream.bits > 8 THEN
		Put16BitsLSB(stream.pend, stream.buf)
	ELSIF stream.bits > 0 THEN
		PutChar(stream.pend, CHR(stream.buf))
	END;
	stream.buf := 0; stream.bits := 0
END WindupBits;

(* Set data type to ASCII or Binary, using a crude heuristic: Binary if more than 20% of the bytes are <= 6 or >= 128, ASCII otherwise *)
PROCEDURE SetDataType(VAR stream: Stream);
VAR
	n, ascii, bin: LONGINT;
BEGIN
	WHILE n < 7 DO INC(bin, LONG(stream.lnode[n].freqOrCode)); INC(n) END;
	WHILE n < 128 DO INC(ascii, LONG(stream.lnode[n].freqOrCode)); INC(n) END;
	WHILE n < Literals DO INC(bin, LONG(stream.lnode[n].freqOrCode)); INC(n) END;
	IF (4 * bin) > ascii THEN stream.dataType := Binary ELSE stream.dataType := Ascii END
END SetDataType;

(* Generate the codes for a given tree and bit counts (which need not to be optimal) *)
PROCEDURE GenCodes(VAR node: Nodes; maxCode: INTEGER; VAR count: ARRAY OF INTEGER);
VAR
	nextCode: ARRAY MaxBits + 1 OF INTEGER;	(* next code value for each bit length *)
	code, bits, n, len : INTEGER;
BEGIN
	code := 0;
	FOR bits := 1 TO MaxBits DO
		code := INTEGER(ASH(code + count[bits - 1], 1));
		nextCode[bits] := code
	END;
	ASSERT(code + count[MaxBits] - 1 = ASH(1, MaxBits) - 1, 110);	(* inconsistent bit counts *)
	FOR n := 0 TO maxCode DO
		len := node[n].dadOrLen;
		IF len # 0 THEN
			node[n].freqOrCode := ReverseBits(nextCode[len], len); INC(nextCode[len])
		END
	END
END GenCodes;

(* Compute optimal bit lengths for a tree and update the total bit length for the current block *)
PROCEDURE GenBitLen(VAR stream: Stream; VAR tree: Tree);
VAR
	node: Nodes;
	stree: StaticTree;
	bits, h, n, m, overflow, xbits : INTEGER;
	freq: LONGINT;
BEGIN
	node := tree.node;
	stree := tree.static;
	overflow := 0;
	FOR bits := 0 TO MaxBits DO stream.bitLenCount[bits] := 0 END;
	(* compute optimal bit lengths *)
	node[stream.heap[stream.heapMax]].dadOrLen := 0;	(* root of heap *)
	FOR h := stream.heapMax + 1 TO HeapSize - 1 DO
		n := stream.heap[h];
		bits := node[node[n].dadOrLen].dadOrLen + 1;
		IF bits > stree.maxLength THEN
			bits := stree.maxLength; INC(overflow)
		END;
		node[n].dadOrLen := bits;	(* replace dad with len information *)
		IF n <= tree.maxCode THEN	(* leaf node *)
			INC(stream.bitLenCount[bits]);
			IF n >= stree.base THEN xbits := stree.bits[n - stree.base] ELSE xbits := 0 END;
			freq := node[n].freqOrCode;
			INC(stream.optLen, freq * (bits + xbits));
			IF stree.node # NIL THEN INC(stream.staticLen, freq * (stree.node[n].dadOrLen + xbits)) END
		END
	END;

	IF overflow # 0 THEN
		(* find first bit length which could increase *)
		REPEAT
			bits := stree.maxLength - 1;
			WHILE stream.bitLenCount[bits] = 0 DO DEC(bits) END;
			DEC(stream.bitLenCount[bits]);	(* move one leaf down the tree *)
			INC(stream.bitLenCount[bits + 1], 2);	(* move one overflow item as its brother *)
			DEC(stream.bitLenCount[stree.maxLength]); DEC(overflow, 2)
		UNTIL overflow <= 0;

		(* recompute all bit lengths, scanning in increasing frequency *)
		bits := stree.maxLength;
		WHILE bits > 0 DO
			n := stream.bitLenCount[bits];
			WHILE n # 0 DO
				DEC(h); m := stream.heap[h];
				IF m <= tree.maxCode THEN
					IF node[m].dadOrLen # bits THEN
						INC(stream.optLen, (bits - node[m].dadOrLen) * LONG(node[m].freqOrCode));
						node[m].dadOrLen := bits
					END;
					DEC(n)
				END
			END;
			DEC(bits)
		END
	END
END GenBitLen;

(* Restore heap property by moving down the tree starting at node k, exchanging a node with smallest child if necessary,
	stopping when heap property is re-established (each father smaller than its two children *)
PROCEDURE Sift(VAR stream: Stream; VAR node: Nodes; k: INTEGER);
VAR
	v, i: INTEGER;

	(* Compare subtrees, using tree depth as tie breaker when subtrees have equal frequency -> minimizes worst case length *)
	PROCEDURE Smaller(n, m: INTEGER): BOOLEAN;
	BEGIN
		RETURN (node[n].freqOrCode < node[m].freqOrCode) OR
			((node[n].freqOrCode = node[m].freqOrCode) & (stream.depth[n] <= stream.depth[m]))
	END Smaller;

BEGIN
	v := stream.heap[k];
	i := k * 2;	(* left child of k *)
	WHILE (i <= stream.heapLen)  DO
		IF (i < stream.heapLen) & Smaller(stream.heap[i + 1], stream.heap[i]) THEN INC(i) END;	(* i: smallest child *)
		IF Smaller(v, stream.heap[i]) THEN
			stream.heap[k] := v; RETURN
		ELSE
			stream.heap[k] := stream.heap[i]; k := i;	(* exchange v with smallest child *)
			i := i * 2	(* set j to the left child of k *)
		END
	END;
	stream.heap[k] := v
END Sift;

(* Construct one Huffman tree and assign the code bit strings and lengths. Update the total bit length for the current block.
	IN assertion: field freqOrCode is set for all tree elements
	OUT assertions: the fields dadOrLen and freqOrCode are set to the optimal bit length and corresponding code.
		The stream.optLen is updated; stream.staticLen is also updated if snode is not null. The field maxCode is set. *)
PROCEDURE BuildTree(VAR stream: Stream; VAR tree: Tree);
VAR
	node: Nodes;
	stree: StaticTree;
	n, m, maxCode, next: INTEGER;
BEGIN
	node := tree.node; stree := tree.static; maxCode := -1;

	(* construct initial heap *)
	stream.heapLen := 0; stream.heapMax := HeapSize;
	FOR n := 0 TO stree.elems - 1 DO
		IF node[n].freqOrCode # 0 THEN
			maxCode := n;
			INC(stream.heapLen); stream.heap[stream.heapLen] := n;
			stream.depth[n] := 0
		ELSE
			node[n].dadOrLen := 0
		END
	END;

	(* force at least two codes of non zero frequency in order to be compliant with pkzip format *)
	WHILE stream.heapLen < 2 DO
		INC(stream.heapLen);
		IF maxCode < 2 THEN INC(maxCode); n := maxCode ELSE n := 0 END;
		stream.heap[stream.heapLen] := n;
		node[n].freqOrCode := 1;
		stream.depth[n] := 0;
		DEC(stream.optLen);
		IF stree.node # NIL THEN DEC(stream.staticLen, LONG(stree.node[n].dadOrLen)) END;	(* n IN {0, 1}, thus no extra bits *)
	END;
	tree.maxCode := maxCode;

	(* build heap *)
	FOR n := stream.heapLen DIV 2 TO 1 BY -1 DO
		Sift(stream, node, n)
	END;

	(* construct Huffman tree by repeatedly combining the least two frequent nodes *)
	next := stree.elems;
	REPEAT
		n := stream.heap[1];
		stream.heap[1] := stream.heap[stream.heapLen];
		DEC(stream.heapLen);
		Sift(stream, node, 1);
		m := stream.heap[1];	(* n: node of least frequency; m: node of next least frequency *)
		DEC(stream.heapMax); stream.heap[stream.heapMax] := n;	(* keep the nodes sorted by frequency *)
		DEC(stream.heapMax); stream.heap[stream.heapMax] := m;
		node[next].freqOrCode := node[n].freqOrCode + node[m].freqOrCode;	(* create a new father of n and m *)
		IF stream.depth[n] > stream.depth[m] THEN stream.depth[next] := stream.depth[n] + 1
		ELSE stream.depth[next] := stream.depth[m] + 1
		END;
		node[n].dadOrLen := next; node[m].dadOrLen := next;
		(* and insert the new node in the heap *)
		stream.heap[1] := next; INC(next);
		Sift(stream, node, 1);
	UNTIL stream.heapLen < 2;
	DEC(stream.heapMax); stream.heap[stream.heapMax] := stream.heap[1];
	(* field freqOrCode and dadOrLen are set -> generate bit lengths *)
	GenBitLen(stream, tree);
	(* field dadOrLen is set -> generate bit codes *)
	GenCodes(node, maxCode, stream.bitLenCount)
END BuildTree;

(* Scan a literal or distance tree to determine the frequencies of the codes in the bit length tree. *)
PROCEDURE ScanTree(VAR stream: Stream; node: Nodes; max: INTEGER);
VAR
	n, prevLen, curLen, nextLen, count, maxCount, minCount: INTEGER;
BEGIN
	prevLen := -1; nextLen := node[0].dadOrLen; count := 0;
	IF nextLen = 0 THEN maxCount := 138; minCount := 3
	ELSE maxCount := 7; minCount := 4
	END;
	node[max + 1].dadOrLen := MAX(INTEGER);	(* sentinel *)
	FOR n := 0 TO max DO
		curLen := nextLen; nextLen := node[n + 1].dadOrLen;
		INC(count);
		IF (count >= maxCount) OR (curLen # nextLen) THEN
			IF count < minCount THEN
				INC(stream.bnode[curLen].freqOrCode, count);
			ELSIF curLen # 0 THEN
				IF curLen # prevLen THEN INC(stream.bnode[curLen].freqOrCode) END;
				INC(stream.bnode[Rep3To6].freqOrCode)
			ELSIF count <= 10 THEN
				INC(stream.bnode[RepZero3To10].freqOrCode)
			ELSE
				INC(stream.bnode[RepZero11To138].freqOrCode)
			END;
			count := 0; prevLen := curLen;
			IF nextLen = 0 THEN maxCount := 138; minCount := 3
			ELSIF curLen = nextLen THEN maxCount := 6; minCount := 3
			ELSE maxCount := 7; minCount := 4
			END
		END
	END
END ScanTree;

(* Construct the Huffman tree for the bit lengths and return the index in BitOrder of the last bit length code to send. *)
PROCEDURE BuildBitLenTree(VAR stream: Stream): INTEGER;
VAR
	max: INTEGER;	(* index of last bit length code of non zero frequency *)
BEGIN
	(* determine the bit length frequencies for literal and distance trees *)
	ScanTree(stream, stream.ltree.node, stream.ltree.maxCode);
	ScanTree(stream, stream.dtree.node, stream.dtree.maxCode);
	BuildTree(stream, stream.btree);	(* build bit length tree *)
	(* stream.optLen now includes the length of the tree representations, except the lengths of the bit lengths codes
		and the 5 + 5 + 4 bits for the count *)
	(* determine the number of bit length codes to send; the pkzip format requires that at least 4 bit length codes to be sent *)
	max := BitCodes - 1;
	WHILE (max >= 3) & (stream.bnode[BitOrder[max]].dadOrLen = 0) DO DEC(max) END;
	(* update stream.optLen to include the bit length tree and counts *)
	INC(stream.optLen, LONG(3 * (max + 1) + 5 + 5 + 4));
	RETURN max
END BuildBitLenTree;

(* Send a literal or distance tree in compressed form, using the codes in stream.bnode.
	tree: the tree to be scanned; max: its largest code of non zero frequency *)
PROCEDURE SendTree(VAR stream: Stream; node: Nodes; max: INTEGER);
VAR
	n, prevLen, curLen, nextLen, count, maxCount, minCount: INTEGER;
BEGIN
	prevLen := -1; nextLen := node[0].dadOrLen; count := 0;
	IF nextLen = 0 THEN maxCount := 138; minCount := 3
	ELSE maxCount := 7; minCount := 4 END;
	node[max + 1].dadOrLen := MAX(INTEGER);	(* sentinel *)
	FOR n := 0 TO max DO
		curLen := nextLen; nextLen := node[n + 1].dadOrLen;
		INC(count);
		IF (count >= maxCount) OR (curLen # nextLen) THEN
			IF count < minCount THEN
				REPEAT
					SendCode(stream, stream.bnode[curLen]);
					DEC(count)
				UNTIL count = 0
			ELSIF curLen # 0 THEN
				IF curLen # prevLen THEN
					SendCode(stream, stream.bnode[curLen]); DEC(count)
				END;
				ASSERT((3 <= count) & (count <= 6), 110);
				SendCode(stream, stream.bnode[Rep3To6]); SendBits(stream, count - 3, 2)
			ELSIF count <= 10 THEN
				SendCode(stream, stream.bnode[RepZero3To10]); SendBits(stream, count - 3, 3)
			ELSE
				SendCode(stream, stream.bnode[RepZero11To138]); SendBits(stream, count - 11, 7)
			END;
			count := 0; prevLen := curLen;
			IF nextLen = 0 THEN maxCount := 138; minCount := 3
			ELSIF curLen = nextLen THEN maxCount := 6; minCount := 3
			ELSE maxCount := 7; minCount := 4
			END
		END
	END
END SendTree;

(* Send the header for a block using dynamic Huffman trees: the counts, the lengths of the bit length codes, the literal tree
	and the distance tree.
	lcodes, dcodes, blcodes: number of codes for each tree *)
PROCEDURE SendAllTrees(VAR stream: Stream; lcodes, dcodes, blcodes: INTEGER);
VAR
	rank: INTEGER;	(* index in BitOrder *)
BEGIN
	ASSERT((lcodes >= 257) & (dcodes >= 1) & (blcodes >= 4), 100);	(* not enough codes *)
	ASSERT((lcodes <= LitLenCodes) & (dcodes <= DistCodes) & (blcodes <= BitCodes), 101);	(* too many codes *)
	SendBits(stream, lcodes - 257, 5); SendBits(stream, dcodes - 1, 5); SendBits(stream, blcodes - 4, 4);
	FOR rank := 0 TO blcodes - 1 DO
		SendBits(stream, stream.bnode[BitOrder[rank]].dadOrLen, 3)
	END;
	SendTree(stream, stream.lnode, lcodes - 1);	(* literal tree *)
	SendTree(stream, stream.dnode, dcodes - 1)	(* distance tree *)
END SendAllTrees;

(* Initialize the various constant tables *)
PROCEDURE InitStaticTrees;
VAR
	n, code: LONGINT;
	length, dist: INTEGER;
	count: ARRAY MaxBits + 1 OF INTEGER;	(* number of codes at each bit length for an optimal tree *)
BEGIN
	NEW(ExtraLenBits, LengthCodes);
	FOR n := 0 TO 3 DO ExtraLenBits[n] := 0 END;
	FOR n := 4 TO LengthCodes - 2 DO ExtraLenBits[n] := SHORT((n - 4) DIV 4) END;
	ExtraLenBits[LengthCodes - 1] := 0;

	NEW(ExtraDistBits, DistCodes);
	FOR n := 0 TO 1 DO ExtraDistBits[n] := 0 END;
	FOR n := 2 TO DistCodes - 1 DO ExtraDistBits[n] := SHORT((n - 2) DIV 2) END;

	NEW(ExtraBitBits, BitCodes);
	FOR n := 0 TO BitCodes - 4 DO ExtraBitBits[n] := 0 END;
	ExtraBitBits[BitCodes - 3] := 2; ExtraBitBits[BitCodes - 2] := 3; ExtraBitBits[BitCodes - 1] := 7;

	BitOrder[0] := 16; BitOrder[1] := 17; BitOrder[2] := 18; BitOrder[3] := 0; BitOrder[4] := 8; BitOrder[5] := 7; BitOrder[6] := 9;
	BitOrder[7] := 6; BitOrder[8] := 10; BitOrder[9] := 5; BitOrder[10] := 11; BitOrder[11] := 4; BitOrder[12] := 12; BitOrder[13] := 3;
	BitOrder[14] := 13; BitOrder[15] := 2; BitOrder[16] := 14; BitOrder[17] := 1; BitOrder[18] := 15;

	(* initialize the mapping length (0..255) -> length code (0..28) *)
	length := 0;
	FOR code := 0 TO LengthCodes - 2 DO
		BaseLength[code] := length;
		FOR n := 0 TO ASH(1, ExtraLenBits[code]) - 1 DO
			LengthCode[length] := CHR(code); INC(length)
		END
	END;
	ASSERT(length = 256, 110);
	(* Note that length code 255 (match length 258) can be represented in two different ways: code 284 + 5 bits or code 285,
		so we overwrite LengthCode[255] to use the best encoding: *)
	LengthCode[length - 1] := CHR(code);

	(* initialize the mapping dist (0..32K) -> dist code (0..29) *)
	dist := 0;
	FOR code := 0 TO 15 DO
		BaseDist[code] := dist;
		FOR n := 0 TO ASH(1, ExtraDistBits[code]) - 1 DO
			DistCode[dist] := CHR(code); INC(dist)
		END
	END;
	ASSERT(dist = 256, 111);

	dist := INTEGER(ASH(dist, -7));	(* from now on, all distances are divided by 128 *)
	FOR code := 16 TO DistCodes - 1 DO
		BaseDist[code] := INTEGER(ASH(dist, 7));
		FOR n := 0 TO ASH(1, ExtraDistBits[code] - 7) - 1 DO
			DistCode[256 + dist] := CHR(code); INC(dist)
		END
	END;
	ASSERT(dist = 256, 112);

	(* construct the codes of the static literal tree *)
	NEW(LTree.node, LitLenCodes + 2);
	LTree.bits := ExtraLenBits; LTree.base := Literals + 1; LTree.elems := LitLenCodes; LTree.maxLength := MaxBits;
	FOR n := 0 TO MaxBits DO count[n] := 0 END;
	FOR n := 0 TO 143 DO LTree.node[n].dadOrLen := 8 END; INC(count[8], 143 - (-1));
	FOR n := 144 TO 255 DO LTree.node[n].dadOrLen := 9 END; INC(count[9], 255 - 143);
	FOR n := 256 TO 279 DO LTree.node[n].dadOrLen := 7 END; INC(count[7], 279 - 255);
	FOR n := 280 TO 287 DO LTree.node[n].dadOrLen := 8 END; INC(count[8], 287 - 279);
	(* codes 286 and 287 do not exist, but we must include them in the tree construction to get a canonical Huffman tree
		(longest code all ones) *)
	GenCodes(LTree.node, LitLenCodes + 1, count);

	(* construct the codes of the static distance tree (trivial) *)
	NEW(DTree.node, DistCodes);
	DTree.bits := ExtraDistBits; DTree.base := 0; DTree.elems := DistCodes; DTree.maxLength := MaxBits;
	FOR n := 0 TO DistCodes - 1 DO
		DTree.node[n].dadOrLen := 5;
		DTree.node[n].freqOrCode := ReverseBits(SHORT(n), 5)
	END;

	BTree.node := NIL;
	BTree.bits := ExtraBitBits; BTree.base := 0; BTree.elems := BitCodes; BTree.maxLength := MaxBitLenBits;
END InitStaticTrees;

(* Initialize a new block *)
PROCEDURE InitBlock(VAR stream: Stream);
VAR
	n: LONGINT;	(* iterates over tree elements *)
BEGIN
	FOR n := 0 TO LitLenCodes - 1 DO stream.lnode[n].freqOrCode := 0 END;
	FOR n := 0 TO DistCodes - 1 DO stream.dnode[n].freqOrCode := 0 END;
	FOR n := 0 TO BitCodes - 1 DO stream.bnode[n].freqOrCode := 0 END;
	stream.lnode[EndBlock].freqOrCode := 1;
	stream.optLen := 0; stream.staticLen := 0;
	stream.lastLit := 0
END InitBlock;

(* Initialize the tree data structures for a new zlib stream *)
PROCEDURE InitTrees(VAR stream: Stream);
BEGIN
	NEW(stream.lnode, HeapSize); NEW(stream.dnode, 2 * DistCodes + 1); NEW(stream.bnode, 2 * BitCodes + 1);
	stream.ltree.node := stream.lnode; stream.dtree.node := stream.dnode; stream.btree.node := stream.bnode;
	stream.ltree.static := LTree; stream.dtree.static := DTree; stream.btree.static := BTree;
	stream.buf := 0; stream.bits := 0; stream.lastEobLen := 8;	(* enough lookahead for inflate *)
	InitBlock(stream)
END InitTrees;

PROCEDURE FreeTrees(VAR stream: Stream);
BEGIN
	stream.lnode := NIL; stream.dnode := NIL; stream.bnode := NIL
END FreeTrees;

(* Send one empty static block to give enough lookahead for inflate. This takes 10 bits, of which 7 may remain in the bit buffer.
	The current inflate code requires 9 bits of lookahead. If the last two codes for the previous block (real code plus end of block)
	were coded on 5 bits or less, inflate may have only 5 + 3 bits of lookahead to decode the las real code.
	In this case we send two empty static blocks instead of one. (There are no problems if the previous block is stored or fixed.)
	To simplify the code, we assume the worst case of last real code encoded on one bit only *)
PROCEDURE AlignTrees(VAR stream: Stream);
BEGIN
	SendBits(stream, ASH(StaticTrees, 1), 3);
	SendCode(stream, LTree.node[EndBlock]);
	FlushBits(stream);
	(* Of the 10 bits for the empty block, we have already sent (10 - stream.bits) bits. The lookahead for the last real code
		(before end of block of the previous block) was thus at least one plus the length of the end of block what we have
		just sent of the empty static block. *)
	IF (1 + stream.lastEobLen + 10 - stream.bits) < 9 THEN
		SendBits(stream, ASH(StaticTrees, 1), 3);
		SendCode(stream, LTree.node[EndBlock]);
		FlushBits(stream)
	END;
	stream.lastEobLen := 7
END AlignTrees;

(* Copy a stored block, storing first the length and its one's complement if requested *)
PROCEDURE CopyBlock(VAR stream: Stream; VAR buf: ARRAY OF CHAR; offset, len: LONGINT; header: BOOLEAN);
VAR
BEGIN
	WindupBits(stream);	(* align on byte boundary *)
	stream.lastEobLen := 8;	(* enough lookahead for inflate *)
	IF header THEN
		Put16BitsLSB(stream.pend, len);	(* LEN *)
		Put16BitsLSB(stream.pend, -(len + 1));	(* NLEN (1's complement of LEN) *)
	END;
	WHILE len > 0 DO
		PutChar(stream.pend, buf[offset]);
		INC(offset); DEC(len)
	END
END CopyBlock;

(* Send a stored block *)
PROCEDURE StoreBlock(VAR stream: Stream; VAR buf: ARRAY OF CHAR; offset, len: LONGINT; eof: BOOLEAN);
VAR
	value: LONGINT;
BEGIN
	value := ASH(StoredBlock, 1);
	IF eof THEN INC(value) END;
	SendBits(stream, value, 3);	(* send block type *)
	CopyBlock(stream, buf, offset, len, TRUE);	(* with header *)
END StoreBlock;

(* Send the block data compressed using the given Huffman trees *)
PROCEDURE CompressBlock(VAR stream: Stream; lnode, dnode: Nodes);
VAR
	dist: INTEGER;	(* distance of matched string *)
	lc: INTEGER;	(* match length or unmatched char (if dist = 0) *)
	code: INTEGER;	(* the code to send *)
	extra: INTEGER;	(* number of extra bits to send *)
	lx: LONGINT;	(* running index in lbuf and dbuf *)
BEGIN
	IF stream.lastLit # 0 THEN
		lx := 0;
		REPEAT
			dist := stream.dbuf[lx];
			lc := ORD(stream.lbuf[lx]);
			INC(lx);
			IF dist = 0 THEN
				SendCode(stream, lnode[lc]);	(* send a literal byte *)
			ELSE	(* lc is (match length - MinMatch) *)
				code := ORD(LengthCode[lc]);
				SendCode(stream, lnode[code + Literals + 1]);	(* send length code *)
				extra := ExtraLenBits[code];
				IF extra # 0 THEN
					DEC(lc, BaseLength[code]);
					SendBits(stream, lc, extra)
				END;
				DEC(dist);	(* dist is now (match distance - 1) *)
				IF dist < 256 THEN code := ORD(DistCode[dist]);
				ELSE code := ORD(DistCode[256 + ASH(dist, -7)])
				END;
				ASSERT(code < DistCodes, 110);	(* bad DistCode *)
				SendCode(stream, dnode[code]);
				extra := ExtraDistBits[code];
				IF extra # 0 THEN
					DEC(dist, BaseDist[code]);
					SendBits(stream, dist, extra)	(* send extra distance bits *)
				END
			END	(* literal or match pair? *)
			(* no need to check for overlay consistency since we don't overlay *)
		UNTIL lx = stream.lastLit
	END;
	SendCode(stream, lnode[EndBlock]);
	stream.lastEobLen := lnode[EndBlock].dadOrLen
END CompressBlock;

(* Flush the current block, with given end-of-file flag, determine the best encoding for the current block:
	dynamic trees, static trees or store, and output the encoded block to the zip file.
	buf: input block, or NULL if too old;
	pos, len: position in and length of input block;
	eof: true if this is the last block for a file;
	IN assertion: stream.string is set to the end of the current match *)
PROCEDURE FlushBlock(VAR stream: Stream; VAR buf: ARRAY OF CHAR; pos, len: LONGINT; eof: BOOLEAN);
VAR
	max: INTEGER;	(* index of last bit length code of non zero freqency *)
	optLen, staticLen: LONGINT;	(* optLen and staticLen in bytes *)
	value: LONGINT;
BEGIN
	IF stream.level > 0 THEN	(* build a Huffman tree unless a stored block is forced *)
		IF stream.dataType = Unknown THEN SetDataType(stream) END;	(* check if the file is ascii or binary *)
		BuildTree(stream, stream.ltree);	(* construct the literal .. *)
		BuildTree(stream, stream.dtree);	(* .. and the distance tree *)
		(* at this point, stream.optLen and stream.staticLen are the total bit lengths of the compressed block data,
			excluding tree representations *)
		max := BuildBitLenTree(stream);	(* build bit length tree for the above tow trees, get the index of the last bit length code *)
		optLen := (stream.optLen + 3 + 7) DIV 8;
		staticLen := (stream.staticLen + 3 + 7) DIV 8;
		IF staticLen < optLen THEN optLen := staticLen END;
	ELSE
		ASSERT(pos >= 0, 110);	(* lost buf *)
		optLen := len + 5;
		staticLen := optLen
	END;
	IF len + 4 <= optLen THEN	(* 4: two words for the lengths *)
		ASSERT(pos >= 0, 111);	(* see explanation in trees.c, LitBufSize <= WindowSize avoids lost block *)
		StoreBlock(stream, buf, pos, len, eof);
	ELSIF staticLen = optLen THEN
		value := ASH(StaticTrees, 1);
		IF eof THEN INC(value) END;
		SendBits(stream, value, 3);
		CompressBlock(stream, LTree.node, DTree.node)
	ELSE
		value := ASH(DynamicTrees, 1);
		IF eof THEN INC(value) END;
		SendBits(stream, value, 3);
		SendAllTrees(stream, stream.ltree.maxCode + 1, stream.dtree.maxCode + 1, max + 1);
		CompressBlock(stream, stream.lnode, stream.dnode);
	END;
	InitBlock(stream);
	IF eof THEN
		WindupBits(stream)
	END
END FlushBlock;

(* Put a literal in the literal buffer (stream.lbuf) *)
PROCEDURE TallyLit(VAR stream: Stream; ch: CHAR): BOOLEAN;
BEGIN
	stream.lbuf[stream.lastLit] := ch;
	stream.dbuf[stream.lastLit] := 0;
	INC(stream.lastLit);
	INC(stream.lnode[ORD(ch)].freqOrCode);
	RETURN (stream.lastLit = LitBufSize - 1)
END TallyLit;

(* Put a distance/length pair in the distance and the length buffer (stream.dbuf, stream.lbuf) *)
PROCEDURE TallyDistLen(VAR stream: Stream; dist, len: INTEGER): BOOLEAN;
BEGIN
	ASSERT(len < 256, 99);
	stream.lbuf[stream.lastLit] := CHR(len);
	stream.dbuf[stream.lastLit] := dist;
	INC(stream.lastLit);
	DEC(dist);
	INC(stream.lnode[ORD(LengthCode[len]) + Literals + 1].freqOrCode);
	IF dist < 256 THEN dist := ORD(DistCode[dist])
	ELSE dist := ORD(DistCode[256 + ASH(dist, -7)])
	END;
	INC(stream.dnode[dist].freqOrCode);
	RETURN (stream.lastLit = LitBufSize - 1)
END TallyDistLen;

(*---Matches---*)

PROCEDURE ClearHash(VAR stream: Stream);
VAR
	i: LONGINT;
BEGIN
	FOR i := 0 TO HashSize - 1 DO
		stream.head[i] := 0
	END
END ClearHash;

(* Update a hash value with the given input byte
	IN assertion: all calls are made with consecutive input characters, so that a running hash key can be computed
	from the previous key instead of complete recalculation each time *)
PROCEDURE UpdateHash(VAR h: LONGINT; ch: CHAR);
BEGIN
	h := SYSTEM.VAL(LONGINT, SYSTEM.VAL(SET, ASH(h, HashShift)) / SYSTEM.VAL(SET, LONG(ORD(ch)))) MOD HashSize
END UpdateHash;

(* Insert string starting at position pos in the dictionary and set head to the previous head of the hash chain
	(the most recent string with the same hash key). Return the previous length of the hash chain.
	IN assertion: all calls are made with consecutive input characters and the first MinMatch bytes at pos are valid
	(except for the last MinMatch - 1 bytes of the input file *)
PROCEDURE InsertString(VAR stream: Stream; pos: LONGINT; VAR head: LONGINT);
BEGIN
	UpdateHash(stream.hash, stream.window[pos + MinMatch - 1]);
	head := stream.head[stream.hash];
	stream.prev[pos MOD WindowSize] := head;
	stream.head[stream.hash] := pos
END InsertString;

(* initialize the "longes match" routines for a new zlib stream *)
PROCEDURE InitMatches(VAR stream: Stream);
BEGIN
	ClearHash(stream);
	stream.string := 0; stream.block := 0; stream.lookAhead := 0;
	stream.matchLen := MinMatch - 1; stream.prevLen := MinMatch - 1;
	stream.prevAvail := FALSE; stream.hash := 0;
END InitMatches;

(* Set stream.match to the longest match starting at the given string and return its length.
	Matches shorter or equal to stream.prevLen are discarded, in which case the result is equal to stream.prevLen
	and stream.match is garbage.
	IN assertion: cur is the head of the hash chain for the current string (stream.string) and its distance is <= MaxDist,
		and stream.prevLen >= 1.
	OUT assertion: the match length is not greater than stream.lookAhead. *)
PROCEDURE LongestMatch(VAR stream: Stream; cur: LONGINT): LONGINT;
VAR
	chainLen: LONGINT;	(* max hash chain length *)
	scan: LONGINT;	(* current string *)
	match: LONGINT;	(* matched string *)
	len: LONGINT;	(* length of current match *)
	bestLen: LONGINT;	(* best match so far *)
	niceLen: LONGINT;	(* stop if match long enough *)
	limit: LONGINT;	(* stop when cur becomes <= limit *)
	strend: LONGINT;
	scanEnd1, scanEnd: CHAR;
BEGIN
	bestLen := stream.prevLen;
	IF bestLen >= ConfigTable[stream.level].GoodLen THEN
		chainLen := ConfigTable[stream.level].MaxChain DIV 4	(* do not waste too much time if match is already good enough *)
	ELSE
		chainLen := ConfigTable[stream.level].MaxChain;
	END;
	IF ConfigTable[stream.level].NiceLen > stream.lookAhead THEN	(* do not look for matches beyond the end of the input *)
		niceLen := stream.lookAhead
	ELSE
		niceLen := ConfigTable[stream.level].NiceLen
	END;
	scan := stream.string;
	IF scan > MaxDist THEN limit := scan - MaxDist ELSE limit := 0 END;
	strend := scan + MaxMatch;
	scanEnd1 := stream.window[scan + bestLen - 1];
	scanEnd := stream.window[scan + bestLen];
	ASSERT(scan <= 2 * WindowSize - MinLookAhead, 110);	(* need lookahead *)
	len := -1;
	REPEAT
		IF cur >= stream.string THEN RETURN 0 END;
(*		ASSERT(cur < stream.string, 111);	(* no future *) *)
		match := cur;

		(* skip to next match if match length cannot increase or match lengtch < 2 *)
		IF (stream.window[match + bestLen] = scanEnd) & (stream.window[match + bestLen - 1] = scanEnd1) &
			(stream.window[match] = stream.window[scan]) & (stream.window[match + 1] = stream.window[scan + 1]) THEN
		(* The check at match + bestLen - 1 can be removed because it will be made again later (this heuristic is not always a win).
			It is not necessary to compare match + 2 and scan + 2 since they are always equal when the other bytes match,
			given that the hash keys are equal and that HashBits >= 8 *)
			INC(scan, 2); INC(match, 2);
			ASSERT(stream.window[match] = stream.window[scan], 112);	(* must be equal as well because hash values coincide *)
			REPEAT
				INC(match); INC(scan)
			UNTIL (stream.window[match] # stream.window[scan]) OR (scan >= strend);
			ASSERT(scan <= 2 * WindowSize - 1, 113);	(* wild scan *)
			len := MaxMatch - (strend - scan);
			scan := strend - MaxMatch;
			IF len > bestLen THEN
				stream.match := cur;
				bestLen := len;
				scanEnd1 := stream.window[scan + bestLen - 1];
				scanEnd := stream.window[scan + bestLen]
			END
		END;
		cur := stream.prev[cur MOD WindowSize];
		DEC(chainLen)
	UNTIL (len >= niceLen) OR (cur <= limit) OR (chainLen = 0);
	IF bestLen > MaxMatch THEN bestLen := MaxMatch END;	(* neu *)
	IF bestLen <= stream.lookAhead THEN
		RETURN bestLen
	ELSE
		RETURN stream.lookAhead
	END
END LongestMatch;

(* Check that the match at stream.match is indeed a match *)
PROCEDURE CheckMatch(VAR stream: Stream; start, match, len: LONGINT);
BEGIN
	WHILE len # 0 DO
		ASSERT(stream.window[match] = stream.window[start]);
		INC(match); INC(start); DEC(len)
	END
END CheckMatch;

(* Fill window when lookahead becomes insufficient.
	Updates stream.string and stream.lookAhead *)
PROCEDURE FillWindow(VAR stream: Stream);
VAR
	n, len: LONGINT;
	more: LONGINT;	(* amount of free space at the end of the window *)
BEGIN
	more := 2 * WindowSize - (stream.lookAhead + stream.string);
	REPEAT
		IF stream.string >= WindowSize + MaxDist THEN
			(* lower half is no longer available for matches -> slide window *)
			SYSTEM.MOVE(SYSTEM.ADR(stream.window[WindowSize]), SYSTEM.ADR(stream.window[0]), WindowSize);
			DEC(stream.match, WindowSize); DEC(stream.string, WindowSize); DEC(stream.block, WindowSize);
			(* slide hash table *)
			n := HashSize;
			REPEAT
				DEC(n);
				IF stream.head[n] >= WindowSize THEN
					DEC(stream.head[n], WindowSize)
				ELSE
					stream.head[n] := 0
				END
			UNTIL n = 0;
			n := WindowSize;
			REPEAT
				DEC(n);
				IF stream.prev[n] >= WindowSize THEN
					DEC(stream.prev[n], WindowSize)
				ELSE
					stream.prev[n] := 0
				END
			UNTIL n = 0;
			INC(more, WindowSize)
		END;
		len := stream.in.avail;
		IF len = 0 THEN RETURN END;
		ASSERT(more >= 2, 110);
		IF len > more THEN len := more END;
		ZlibBuffers.ReadBytes(stream.in, stream.window^, stream.string + stream.lookAhead, len);
		IF stream.wrapper THEN
			stream.adler := Zlib.Adler32(stream.adler, stream.window^, stream.string + stream.lookAhead, len);
		END;
		INC(stream.lookAhead, len); DEC(more, len);
		(* initialize hash value now there is some input *)
		IF stream.lookAhead >= MinMatch THEN
			stream.hash := LONG(ORD(stream.window[stream.string]));
			UpdateHash(stream.hash, stream.window[stream.string + 1]);
		END
		(* if the whole input has less than MinMatch bytes, stream.hash is garbage,
			but this is not important since only literal bytes will be emitted *)
	UNTIL (stream.lookAhead >= MinLookAhead) OR (stream.in.avail = 0)
END FillWindow;

(*---Compressor Methods---*)

(* store without compression as much as possible from the input stream, return the current block state.
	This function does not insert new strings in the dictionary since uncompressible data is probably not useful. *)
PROCEDURE CompressStored(VAR stream: Stream; flush: SHORTINT): SHORTINT;
CONST
	MaxBlockSize = PendingBufSize - 5; (* header for stored block takes 5 bytes *)
BEGIN
	(* MaxBlockSize is the minimum of the maximal block size of 0FFFFH and the size of the pending buffer minus 5 bytes for
		the block header. For MemLevel <= 8, PendingBufSize - 5 < 0FFFFH! *)
	ASSERT(PendingBufSize - 5 < 0FFFFH, 110);
	LOOP
		(* fill the window as much as possible *)
		IF stream.lookAhead <= 1 THEN
			ASSERT((stream.string < (WindowSize + MaxDist)) OR (stream.block >= WindowSize), 111); (* slide too late *)
			FillWindow(stream);
			IF stream.lookAhead = 0 THEN
				IF flush = NoFlush THEN RETURN NeedMore
				ELSE EXIT		(* flush the current block *)
				END
			END
		END;
		ASSERT(stream.block >= 0, 112); (* block gone *)
		INC(stream.string, stream.lookAhead);
		stream.lookAhead := 0;

		(* zlib flushes the block if the pending buffer will be full. With MemLevel = 8 and WindowBits = 15 this is impossible
			since MaxBlockSize is almost twice the window size *)
		ASSERT(stream.string < stream.block + MaxBlockSize, 113);

		(* flush if we may have to slide, otherwise stream.block may become negative and the data will be lost *)
		IF (stream.string - stream.block) >= MaxDist THEN
			FlushBlock(stream, stream.window^, stream.block, stream.string - stream.block, FALSE);
			stream.block := stream.string;
			FlushPending(stream.pend, stream.out);
			IF stream.out.avail = 0 THEN RETURN NeedMore
			END
		END
	END;
	FlushBlock(stream, stream.window^, stream.block, stream.string - stream.block, flush = Finish);
	stream.block := stream.string;
	FlushPending(stream.pend, stream.out);
	IF (stream.out.avail = 0) & (flush = Finish) THEN RETURN FinishStarted
	ELSIF stream.out.avail = 0 THEN RETURN NeedMore
	ELSIF flush = Finish THEN RETURN  FinishDone
	ELSE RETURN BlockDone
	END
END CompressStored;

(* Compress without lazy matches.
	This function inserts new strings in the dictionary only for unmatched strings or for short matches. *)
PROCEDURE CompressFast(VAR stream: Stream; flush: SHORTINT): SHORTINT;
VAR
	head: LONGINT; (* head of the hash chain *)
	mustFlush: BOOLEAN; (* set if current block must be flushed *)
BEGIN
	head := 0;
	LOOP
		(* make sure that we always have enough lookahead, except at the end of the input file.
			We need MaxMatch bytes for the next match, plus MinMatch bytes to insert the string following the next match *)
		IF stream.lookAhead < MinLookAhead THEN
			FillWindow(stream);
			IF (stream.lookAhead < MinLookAhead) & (flush = NoFlush) THEN RETURN NeedMore
			ELSIF stream.lookAhead = 0 THEN EXIT		(* flush the current block *)
			END
		END;
		(* Insert the string window[stream.string .. stream.string + 2] in the dictionary,
			and set stream.hash to the head of the hash chain *)
		IF stream.lookAhead >= MinMatch THEN
			InsertString(stream, stream.string, head)
		END;
		(* Find the longest match, discarding those <= prevLen. At this point we have always matchLen < MinMatch *)
		IF (head # 0) & ((stream.string - head) <= MaxDist) THEN
			IF stream.strategy # HuffmanOnly THEN	(* avoid matches with string at index 0, in particular with itself *)
				stream.matchLen := LongestMatch(stream, head)	(* LongestMatch sets match *)
			END
		END;
		IF stream.matchLen >= MinMatch THEN
			CheckMatch(stream, stream.string, stream.match, stream.matchLen);
			mustFlush := TallyDistLen(stream, SHORT(stream.string - stream.match), SHORT(stream.matchLen - MinMatch));
			DEC(stream.lookAhead, stream.matchLen);
			(* Insert new strings in the hash table only if the match length is not too large.
				This saves time but degrades compression *)
			IF (stream.matchLen <= ConfigTable[stream.level].MaxLazy) & (stream.lookAhead >= MinMatch) THEN
				DEC(stream.matchLen);	(* string at stream.string is already in hash table *)
				REPEAT
					INC(stream.string);
					InsertString(stream, stream.string, head);
					(* stream.string never exceeds WindowSize - MaxMatch, so there are always MinMatch bytes ahead *)
					DEC(stream.matchLen)
				UNTIL stream.matchLen = 0;
				INC(stream.string);
			ELSE
				INC(stream.string, stream.matchLen);
				stream.matchLen := 0;
				stream.hash := ORD(stream.window[stream.string]);
				UpdateHash(stream.hash, stream.window[stream.string + 1])
				(* If stream.lookAhead < MinMatch, stream.hash is garbage,
					but it does not matter since it will recomputed at next Deflate call *)
			END
		ELSE	(* no match, output a literal byte *)
			mustFlush := TallyLit(stream, stream.window[stream.string]);
			DEC(stream.lookAhead);
			INC(stream.string)
		END;
		IF mustFlush THEN
			FlushBlock(stream, stream.window^, stream.block, stream.string - stream.block, FALSE);
			stream.block := stream.string;
			FlushPending(stream.pend, stream.out);
			IF stream.out.avail = 0 THEN RETURN NeedMore
			END
		END
	END;
	FlushBlock(stream, stream.window^, stream.block, stream.string - stream.block, flush = Finish);
	stream.block := stream.string;
	FlushPending(stream.pend, stream.out);
	IF (stream.out.avail = 0) & (flush = Finish) THEN RETURN FinishStarted
	ELSIF stream.out.avail = 0 THEN RETURN NeedMore
	ELSIF flush = Finish THEN RETURN FinishDone
	ELSE RETURN BlockDone
	END
END CompressFast;

(* Same as above, but achieves a better compression. We use lazy evaluation for matches:
	a match is finally adopted only if there is no better match at the next window position *)
PROCEDURE CompressSlow(VAR stream: Stream; flush: SHORTINT): SHORTINT;
VAR
	head: LONGINT; (* head of the hash chain *)
	maxIns: LONGINT;
	mustFlush: BOOLEAN; (* set if current block must be flushed *)
BEGIN
	head := 0;
	LOOP
		(* make sure that we always have enough lookahead, except at the end of the input file.
			We need MaxMatch bytes for the next match, plus MinMatch bytes to insert the string following the next match *)
		IF stream.lookAhead < MinLookAhead THEN
			FillWindow(stream);
			IF (stream.lookAhead < MinLookAhead) & (flush = NoFlush) THEN RETURN NeedMore
			ELSIF stream.lookAhead = 0 THEN EXIT
			END
		END;
		(* Insert the string window[stream.string .. stream.string + 2] in the dictionary,
			and set stream.hash to the head of the hash chain *)
		IF stream.lookAhead >= MinMatch THEN
			InsertString(stream, stream.string, head);
		END;
		(* Find the longest match, discarding those <= stream.prevLen *)
		stream.prevLen := stream.matchLen;
		stream.prevMatch := stream.match;
		stream.matchLen := MinMatch - 1;
		IF (head # 0) & (stream.prevLen < ConfigTable[stream.level].MaxLazy) & (stream.string - head <= MaxDist) THEN
			(* avoid matches with string at index 0, in particular with itself *)
			IF stream.strategy # HuffmanOnly THEN
				stream.matchLen := LongestMatch(stream, head);	(* LongestMatch sets stream.match *)
			END;
			IF (stream.matchLen <= 5) &
				((stream.strategy = Filtered) OR ((stream.matchLen = MinMatch) & ((stream.string - stream.match) > TooFar))) THEN
				(* If stream.prevMatch is also MinMatch, stream.match is garbage but we will ignore the current match anyway *)
				stream.matchLen := MinMatch - 1
			END
		END;

		(* If there was a match at the previous step and the current match is not better, output the previous match: *)
		IF (stream.prevLen >= MinMatch) & (stream.matchLen <= stream.prevLen) THEN
			maxIns := stream.string + stream.lookAhead - MinMatch;	(* do not insert strings in hash table beyond this *)
			CheckMatch(stream, stream.string - 1, stream.prevMatch, stream.prevLen);
			mustFlush := TallyDistLen(stream, SHORT(stream.string - 1 - stream.prevMatch), SHORT(stream.prevLen - MinMatch));

			(* Insert in hash table all strings up to the end of the match. stream.string - 1 and stream.string are already inserted.
				If there is not enough stream.lookAhead, the last two strings are not inserted in the hash table. *)
			DEC(stream.lookAhead, stream.prevLen - 1);
			DEC(stream.prevLen, 2);
			REPEAT
				INC(stream.string);
				IF stream.string <= maxIns THEN
					InsertString(stream, stream.string, head)
				END;
				DEC(stream.prevLen);
			UNTIL stream.prevLen = 0;
			stream.prevAvail := FALSE;
			stream.matchLen := MinMatch - 1;
			INC(stream.string);
			IF mustFlush THEN
				FlushBlock(stream, stream.window^, stream.block, stream.string - stream.block, FALSE);
				stream.block := stream.string;
				FlushPending(stream.pend, stream.out);
				IF stream.out.avail = 0 THEN RETURN NeedMore
				END
			END
		ELSIF stream.prevAvail THEN
			(* If there was no match at the previous position, output a single literal. If there was a match but the current
				match is longer, truncate the previous match to a single literal. *)
			mustFlush := TallyLit(stream, stream.window[stream.string - 1]);
			IF mustFlush THEN
				FlushBlock(stream, stream.window^, stream.block, stream.string - stream.block, FALSE);
				stream.block := stream.string;
				FlushPending(stream.pend, stream.out)
			END;
			INC(stream.string);
			DEC(stream.lookAhead);
			IF stream.out.avail = 0 THEN RETURN NeedMore
			END
		ELSE
			(* There is no previous match to compare with, wait for the next step to decide *)
			stream.prevAvail := TRUE;
			INC(stream.string);
			DEC(stream.lookAhead)
		END
	END;
	ASSERT(flush # NoFlush, 110);
	IF stream.prevAvail THEN
		mustFlush := TallyLit(stream, stream.window[stream.string - 1]);
		stream.prevAvail := FALSE
	END;
	FlushBlock(stream, stream.window^, stream.block, stream.string - stream.block, flush = Finish);
	stream.block := stream.string;
	FlushPending(stream.pend, stream.out);
	IF (stream.out.avail = 0) & (flush = Finish) THEN RETURN FinishStarted
	ELSIF stream.out.avail = 0 THEN RETURN NeedMore
	ELSIF flush = Finish THEN RETURN FinishDone
	ELSE RETURN BlockDone
	END
END CompressSlow;

(**---Streams---**)

(** reset stream **)
PROCEDURE Reset*(VAR stream: Stream);
BEGIN
	IF ~stream.open THEN
		stream.res := StreamError;
	ELSE
		ZlibBuffers.Reset(stream.in); ZlibBuffers.Reset(stream.out);
		stream.dataType := Unknown;
		stream.pend.beg := 0; stream.pend.end := 0;
		stream.trailerDone := FALSE;
		IF stream.wrapper THEN
			stream.status := InitState
		ELSE
			stream.status := BusyState
		END;
		stream.adler := 1;
		stream.lastFlush := NoFlush;
		InitTrees(stream);
		InitMatches(stream);
		stream.res := Ok;
	END
END Reset;

(** close deflate stream **)
PROCEDURE Close*(VAR stream: Stream);
BEGIN
	IF stream.open THEN
		stream.window := NIL; stream.prev := NIL; stream.head := NIL;
		stream.pend.buf := NIL; stream.lbuf := NIL; stream.dbuf := NIL;
		FreeTrees(stream);
		stream.open := FALSE; stream.res := Ok
	ELSE
		stream.res := StreamError
	END
END Close;

(** initialize deflate stream with compression level and strategy; if wrapper is not set, no header and checksum are generated **)
PROCEDURE Open*(VAR stream: Stream; level, strategy: SHORTINT; wrapper: BOOLEAN);
BEGIN
	IF level = DefaultCompression THEN level := 6 END;
	IF (0 <= level) & (level <= 9) & (DefaultStrategy <= strategy) & (strategy <= HuffmanOnly) THEN
		NEW(stream.window); NEW(stream.prev); NEW(stream.head);
		(* zlib overlays pend.buf, lbuf and dbuf. Since memory usage should not be a very big problem and dbuf stores integers
			instead of bytes they are allocated as seperate memory chunks here *)
		NEW(stream.pend.buf); NEW(stream.lbuf); NEW(stream.dbuf);
		IF (stream.window # NIL) & (stream.prev # NIL) & (stream.head # NIL)
			& (stream.pend.buf # NIL) & (stream.lbuf # NIL) & (stream.dbuf # NIL) THEN
			stream.level := level; stream.strategy := strategy; stream.wrapper := wrapper; stream.open := TRUE;
			Reset(stream)
		ELSE
			stream.open := FALSE;
			Close(stream);
			stream.res := MemError
		END
	ELSE
		stream.open := FALSE;
		stream.res := StreamError
	END
END Open;

(** initializes the compression dictionary from the given byte sequence without producing any compressed output.
	Must be called immediately after Open or Reset before any call of Deflate **)
PROCEDURE SetDictionary*(VAR stream: Stream; VAR dict: ARRAY OF CHAR; len: LONGINT);
VAR
	offset, i, head: LONGINT;
BEGIN
	IF ~stream.open OR (stream.status # InitState) THEN
		stream.res := StreamError;
		RETURN
	END;
	stream.adler := Zlib.Adler32(stream.adler, dict, 0, len);
	IF len >= MinMatch THEN
		IF len > MaxDist THEN
			offset := len - MaxDist;		(* use the tail of the dictionary *)
			len := MaxDist
		ELSE
			offset := 0
		END;
		SYSTEM.MOVE(SYSTEM.ADR(dict[offset]), SYSTEM.ADR(stream.window[0]), len);
		stream.string := len; stream.block := len;
		(* insert all strings in the hash table (except for the last two bytes). stream.lookAhead stays zero,
			so stream.hash will be recomputed at the next call of FillWindow *)
		stream.hash := ORD(stream.window[0]);
		UpdateHash(stream.hash, stream.window[1]);
		FOR i := 0 TO (len - MinMatch) DO
			InsertString(stream, i, head)
		END
	END;
	stream.res := Ok
END SetDictionary;


(** Deflate compresses as much data as possible, and stops when the input buffer becomes empty or the output buffer becomes full;
	the flush parameter decides if and how blocks are terminated **)
PROCEDURE Deflate*(VAR stream: Stream; flush: SHORTINT);
VAR
	lastFlush, bstate: SHORTINT;
	header: LONGINT;
	buf: ARRAY 1 OF CHAR;
BEGIN
	IF ~stream.open OR (flush < NoFlush) OR (flush > Finish) OR ((stream.status = FinishState) & (flush # Finish)) THEN
		stream.res := StreamError;
		RETURN
	END;
	IF stream.out.avail = 0 THEN
		stream.res := BufError;
		RETURN
	END;
	lastFlush := stream.lastFlush; stream.lastFlush := flush;

	(* write zlib header *)
	IF stream.status = InitState THEN
		header := (((WindowBits - 8) * 10H) + Deflated) * 100H;	(* CMF: 7 - 4: CINFO (compression info (=window size - 8)), 3 - 0: CM (compression method) *)
		(* FLG: flags *)	(* FLG.FLEVEL: compression level *)
		IF stream.level >= 7 THEN INC(header, 0C0H)	(* maximum compression, slowest algorithm *)
		ELSIF stream.level >= 5 THEN INC(header, 80H)	(* default algorithm *)
		ELSIF stream.level >= 3 THEN INC(header, 40H)	(* fast algorithm *)
		END;																		(* ELSE fastest algorithm *)
		IF stream.string # 0 THEN
			INC(header, PresetDict)			(* FLG.FDICT: preset dictionary *)
		END;
		INC(header, 31 - (header MOD 31));		(* FLG.FCHECK: check bits for CMF and FLG *)
		stream.status := BusyState;
		Put16BitsMSB(stream.pend, header);
		IF stream.string # 0 THEN		(* DICT: the adler32 checksum of the preset dictionary *)
			Put32BitsMSB(stream.pend, stream.adler)
		END;
		stream.adler := 1;
	END;

	(* flush as much pending output as possible *)
	IF stream.pend.end # 0 THEN
		FlushPending(stream.pend, stream.out);
		IF stream.out.avail = 0 THEN
		    (* Since stream.out.avail is 0, Deflate will be called again with more output space,
		    	but possibly with both stream.pend.end and stream.in.avail equal to zero. There won't be anything to do,
		    	but this is not an error situation so make sure we return Ok instead of BufError at next call of Deflate *)
			stream.lastFlush := -1;
			stream.res := Ok;
			RETURN
		END

	(* make sure there is something to do and avoid duplicate consecutive flushes. For repeated and useless calls with Finish,
		we keep returning StreamEnd instead of BufError *)
	ELSIF (stream.in.avail = 0) & (flush <= lastFlush) & (flush # Finish) THEN
		stream.res := BufError;
		RETURN
	END;

	(* user must not provide more input after the first Finish *)
	IF (stream.status = Finish) & (stream.in.avail # 0) THEN
		stream.res := BufError;
		RETURN
	END;

	(* start a new block or continue the current one *)
	IF (stream.in.avail # 0) OR (stream.lookAhead # 0) OR ((flush # NoFlush) & (stream.status # FinishState)) THEN
		bstate := ConfigTable[stream.level].Compress(stream, flush);
		IF bstate IN {FinishStarted, FinishDone} THEN
			stream.status := FinishState
		END;
		IF bstate IN {NeedMore, FinishStarted} THEN
			IF stream.out.avail = 0 THEN
				stream.lastFlush := -1
			END;
			stream.res := Ok;		(* avoid BufError in next call, see above *)
			RETURN
			(* if (flush # NoFlush) & (out.avail = 0), the next call of Deflate should use the same flush parameter
				to make sure that the flush is complete. So we dont't have to output an empty block here, this will be done at next call.
				This also ensures that for a very small output buffer, we emit at most one empty block. *)
		ELSIF bstate = BlockDone THEN
			IF flush = PartialFlush THEN
				AlignTrees(stream)
			ELSE	(* FullFlush or SyncFlush *)
				StoreBlock(stream, buf, 0, 0, FALSE);	(* for a full flush, this empty block will be recognized as a special marker by Inflate.Sync *)
				IF flush = FullFlush THEN
					ClearHash(stream)		(* forget about all hash chains *)
				END
			END;
			FlushPending(stream.pend, stream.out);
			IF stream.out.avail = 0 THEN
				stream.lastFlush := -1;		(* avoid BufError at next call, see above *)
				stream.res := Ok;
				RETURN
			END
		END
	END;
	ASSERT(stream.out.avail > 0, 111);

	IF flush # Finish THEN
		stream.res := Ok
	ELSIF ~stream.wrapper OR stream.trailerDone THEN
		stream.res := StreamEnd
	ELSE		(* write the zlib trailer (adler32) *)
		Put32BitsMSB(stream.pend, stream.adler);
		FlushPending(stream.pend, stream.out);	(* if stream.out.avail is zero, the application will call deflate again *)
		stream.trailerDone := TRUE;	(* write the trailer only once *)
		IF stream.pend.end = 0 THEN	(* flushed everything left *)
			stream.res := StreamEnd
		ELSE
			stream.res := Ok
		END
	END
END Deflate;


(** change deflate parameters within the stream. If the compression level is changed, the input available so far
	is compressed with the old level (and may be flushed); the new level will take effect only at the next call of Deflate **)
PROCEDURE SetParams*(VAR stream: Stream; level, strategy: SHORTINT);
BEGIN
	IF level = DefaultCompression THEN
		level := 6
	END;
	IF ~stream.open OR (level < 0) OR (9 < level) OR (strategy < DefaultStrategy) OR (HuffmanOnly < strategy) THEN
		stream.res := StreamError
	ELSE
		IF (ConfigTable[level].Compress # ConfigTable[stream.level].Compress) & (stream.in.totalIn # 0) THEN
			Deflate(stream, PartialFlush)
		END;
		stream.level := level;
		stream.strategy := strategy
	END
END SetParams;

(** compress complete stream and return output length in len **)
PROCEDURE Compress* (VAR src, dst: ARRAY OF CHAR; srcoffset, srclen, dstoffset, dstlen: LONGINT; level, strategy: SHORTINT; VAR len: LONGINT; VAR res: LONGINT);
	VAR s: Stream;
BEGIN
	ZlibBuffers.Init(s.in, src, srcoffset, srclen, srclen);
	ZlibBuffers.Init(s.out, dst, dstoffset, dstlen, dstlen);
	Open(s, level, strategy, TRUE);
	IF s.res = Ok THEN
		Deflate(s, Finish);
		IF s.res = StreamEnd THEN
			len := s.out.totalOut;
			Close(s);
			res := s.res
		ELSE
			res := s.res;
			IF res = Ok THEN res := BufError END;
			Close(s)
		END
	ELSE
		res := s.res
	END
END Compress;


BEGIN
	InitStaticTrees();
	ConfigTable[0].GoodLen := 0; ConfigTable[0].MaxLazy := 0; ConfigTable[0].NiceLen := 0;
		ConfigTable[0].MaxChain := 0; ConfigTable[0].Compress := CompressStored;							(* store only *)
	ConfigTable[1].GoodLen := 4; ConfigTable[1].MaxLazy := 4; ConfigTable[1].NiceLen := 8;
		ConfigTable[1].MaxChain := 4; ConfigTable[1].Compress := CompressFast;								(*maximum speed, no lazy matches *)
	ConfigTable[2].GoodLen := 4; ConfigTable[2].MaxLazy := 5; ConfigTable[2].NiceLen := 16;
		ConfigTable[2].MaxChain := 8; ConfigTable[2].Compress :=  CompressFast;
	ConfigTable[3].GoodLen := 4; ConfigTable[3].MaxLazy := 6; ConfigTable[3].NiceLen := 32;
		ConfigTable[3].MaxChain := 32; ConfigTable[3].Compress := CompressFast;
	ConfigTable[4].GoodLen := 4; ConfigTable[4].MaxLazy := 4; ConfigTable[4].NiceLen := 16;
		ConfigTable[4].MaxChain := 16; ConfigTable[4].Compress :=  CompressSlow;							(* lazy matches *)
	ConfigTable[5].GoodLen := 8; ConfigTable[5].MaxLazy := 16; ConfigTable[5].NiceLen := 32;
		ConfigTable[5].MaxChain := 32; ConfigTable[5].Compress :=  CompressSlow;
	ConfigTable[6].GoodLen := 8; ConfigTable[6].MaxLazy := 16; ConfigTable[6].NiceLen := 128;
		ConfigTable[6].MaxChain := 128; ConfigTable[6].Compress :=  CompressSlow;
	ConfigTable[7].GoodLen := 8; ConfigTable[7].MaxLazy := 32; ConfigTable[7].NiceLen := 128;
		ConfigTable[7].MaxChain := 256; ConfigTable[7].Compress :=  CompressSlow;
	ConfigTable[8].GoodLen := 32; ConfigTable[8].MaxLazy := 128; ConfigTable[8].NiceLen := 258;
		ConfigTable[8].MaxChain := 1024; ConfigTable[8].Compress :=  CompressSlow;
	ConfigTable[9].GoodLen := 32; ConfigTable[9].MaxLazy := 128; ConfigTable[9].NiceLen := 258;
		ConfigTable[9].MaxChain := 4096; ConfigTable[9].Compress :=  CompressSlow;						(* maximum compression *)
END ZlibDeflate.