(* 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 ZlibInflate;	(** eos  **)
(** AUTHOR "swalthert"; PURPOSE "Zlib decompression"; *)

	(**
		Decompression of deflated byte streams
	**)
	
	(*
		01.04.2001 - fixed bug in InflateBlock.Stored (didn't calculate t (or wavail?) correctly 
							-> Trap 100 in ZlibBuffers.ReadBytes (offset + len > LEN(buf)))
		11.12.2000 - Constants are imported from Zlib
		18.10.2000 - use Zlib.Adler32(..) instead of Adler32(..) -> import Zlib
		17.10.2000 - fixed bug in InflateBlocks.BlkLens (didn't calculate 1's complement of LEN correctly)
		04.01.2000 - fixed bug in InflateBlocks.BlkCodes (didn't reset s.res.code from StreamEnd to Ok)
		05.01.2000 - fixed bug in InflateCodes.CodeWash (didn't adjust s.buf when decreasing s.bits)
	*)
	
	IMPORT
		SYSTEM, Zlib, ZlibBuffers;
	
	CONST
		(** result codes **)
		Ok* = Zlib.Ok; StreamEnd* = Zlib.StreamEnd; NeedDict* = Zlib.NeedDict;
		StreamError* = Zlib.StreamError; DataError* = Zlib.DataError; MemError* = Zlib.MemError; BufError* = Zlib.BufError;
		
		(** inflate operation codes **)
		NoFlush* = Zlib.NoFlush; SyncFlush* = Zlib.SyncFlush; FullFlush* = Zlib.FullFlush; Finish* = Zlib.Finish;
		
		(* Huffman codes *)
		MaxNodes = 1440;	(* maximum number of nodes in dynamic literal/length and distance trees *)
		MaxFixedNodes = 544;	(* number of nodes in fixed trees *)
		MaxLitLenCodes = 288;	(* 256 bytes + end of block + 31 length codes *)
		MaxNonSimpleCodes = MaxLitLenCodes - 256 - 1;	(* maximal number of non-simple codes *)
		MaxDistCodes = 31;
		OpBase = -128; OpSpecial = 64; OpInvalid = 128; OpEndBlock = 32; OpExtra = 16;	(* operations *)
		
		WindowBits = 15; WindowSize = ASH(1, WindowBits);	(* always use 32k buffer *)
		
		(* decode state *)
		CodeStart = 0; CodeLen = 1; CodeLenExt = 2; CodeDist = 3; CodeDistExt = 4; CodeCopy = 5; CodeLit = 6;
		CodeWash = 7; CodeEnd = 8; CodeBad = 9;
		
		(* block state *)
		BlkType = 0; BlkLens = 1; BlkStored = 2; BlkTable = 3; BlkBTree = 4; BlkDTree = 5; BlkCodes = 6;
		BlkDry = 7; BlkDone = 8; BlkBad = 9;
		
		DeflateMethod* = 8;	(** only supported compression method **)
		PresetDict = 20H;	(* inflate flag indicating use of a preset dictionary *)
		
		(* inflate stream state *)
		InfMethod = 0; InfFlag = 1; InfDict4 = 2; InfDict3 = 3; InfDict2 = 4; InfDict1 = 5; InfDict0 = 6;
		InfBlocks = 7; InfCheck4 = 8; InfCheck3 = 9; InfCheck2 = 10; InfCheck1 = 11; InfDone = 12; InfBad = 13;
		
	
	TYPE
		
		(** result codes **)
		Result* = RECORD
			code-: LONGINT;	(** result code including special conditions and errors **)
			msg-: POINTER TO ARRAY OF CHAR;	(** detailed error description if available **)
		END;
		
		(* code parameters *)
		Lengths = ARRAY OF SHORTINT;
		Code = RECORD
			bits: INTEGER;	(* number of lookup bits *)
			offset: INTEGER;	(* offset in length array *)
			size: INTEGER;	(* number of codes *)
			simple: INTEGER;	(* number of simple codes *)
			extra: ARRAY MaxNonSimpleCodes OF SHORTINT;	(* number of extra bits for non-simple codes *)
			base: ARRAY MaxNonSimpleCodes OF INTEGER;	(* base length/distance for non-simple codes *)
		END;
		
		(* tree nodes for decoding Huffman trees *)
		Node = RECORD
			base: INTEGER;	(* literal, length base, distance base, or table offset *)
			exop: SHORTINT;	(* number of extra bits or operation *)
			bits: SHORTINT;	(* number of bits in this code or subcode *)
		END;
		Nodes = POINTER TO ARRAY OF Node;
		
		TreeNodes = RECORD
			node: Nodes;	(* available nodes *)
			next: LONGINT;	(* index of next available node *)
		END;
		
		Tree = RECORD
			node: Nodes;	(* nodes where tree is stored *)
			base: LONGINT;	(* index of root table *)
			bits: INTEGER;	(* number of lookup bits *)
		END;
		
		(* memory containing last WindowSize bytes of output *)
		Window = ARRAY WindowSize OF CHAR;
		
		(* check function *)
		CheckFunc = PROCEDURE (old: LONGINT; VAR buf: ARRAY OF CHAR; idx, len: LONGINT): LONGINT;
		
		(** inflate stream **)
		Stream* = RECORD
			in*, out*: ZlibBuffers.Buffer;	(** input and output buffers (initialized by client) **)
			(* totalIn-, totalOut-: LONGINT;	(** number of bytes processed **)	*)
			res-: Result;	(** result of last operation **)
			wrapper-: BOOLEAN;	(** if set, the stream has a zlib header and a checksum **)
			open-: BOOLEAN;	(** if set, stream is initialized **)
			
			(* window and lookahead buffer *)
			window: POINTER TO Window;	(* memory for the decompression window *)
			read, write: LONGINT;	(* window read and write index *)
			checkFn: CheckFunc;	(* function calculating checksum over output bytes *)
			check: LONGINT;	(* current output checksum *)
			buf: LONGINT;	(* bit buffer containing up to 32 lookup bits *)
			bits: LONGINT;	(* number of bits in lookup buffer = position of next bit *)
			
			(* inflate state machine *)
			inf: RECORD
				state: INTEGER;	(* current state of stream *)
				method: INTEGER;	(* method byte for state InfFlag *)
				marker: INTEGER;	(* marker bytes for state InfBad *)
				check: RECORD
					calc: LONGINT;	(* calculated sum *)
					stored: LONGINT;	(* stored sum *)
				END
			END;
			
			(* block state machine *)
			block: RECORD
				state: SHORTINT;	(* current block state *)
				last: BOOLEAN;	(* set for last block *)
				left: LONGINT;	(* bytes left to copy for non-compressed blocks *)
				nlit: INTEGER;	(* number of literal/length codes *)
				ndist: SHORTINT;	(* number of distance codes *)
				nclen: SHORTINT;	(* number of code lengths *)
				clen: ARRAY MaxLitLenCodes + MaxDistCodes OF SHORTINT;	(* code lengths of bit, lit/len, or distance code *)
				index: INTEGER;	(* index of next code length *)
				nodes: Nodes;	(* memory for Huffman trees *)
				btree: Tree;	(* bit decoding tree *)
			END;
			
			(* code state machine *)
			decode: RECORD
				state: SHORTINT;	(* current decode state *)
				lltree, dtree: Tree;	(* literal/length and distance tree *)
				tree: Tree;	(* current decoding table *)
				lit: INTEGER;	(* decoded literal *)
				extra: INTEGER;	(* extra bits to get *)
				len: INTEGER;	(* decoded length *)
				dist: INTEGER;	(* distance back to copy from *)
			END;
		END;
		
	
	VAR
		FixedBuilt: BOOLEAN;	(* set if fixed Huffman tables have been built *)
		FixedLitLenTree, FixedDistTree: Tree;	(* nodes for fixed literal/length and distance tree *)
		Order: ARRAY 19 OF SHORTINT;	(* order of code bit lengths *)


	(*--- Results ---*)
	
	(* set error message *)
	PROCEDURE SetMsg (VAR res: Result; msg: ARRAY OF CHAR);
		VAR l: LONGINT;
	BEGIN
		l := 0; WHILE msg[l] # 0X DO INC(l) END;
		NEW(res.msg, l+1); COPY(msg, res.msg^)
	END SetMsg;
	
	
	(*--- Huffman Decoding Tables ---*)
	
	PROCEDURE MakeLitLenCode (VAR code: Code; bits, offset, size, simple: INTEGER);
	BEGIN
		code.bits := bits; code.offset := offset; code.size := size; code.simple := simple;
		IF simple < size THEN
			code.extra[0] := 0; code.extra[1] := 0; code.extra[2] := 0; code.extra[3] := 0;
			code.extra[4] := 0; code.extra[5] := 0; code.extra[6] := 0; code.extra[7] := 0;
			code.extra[8] := 1; code.extra[9] := 1; code.extra[10] := 1; code.extra[11] := 1;
			code.extra[12] := 2; code.extra[13] := 2; code.extra[14] := 2; code.extra[15] := 2;
			code.extra[16] := 3; code.extra[17] := 3; code.extra[18] := 3; code.extra[19] := 3;
			code.extra[20] := 4; code.extra[21] := 4; code.extra[22] := 4; code.extra[23] := 4;
			code.extra[24] := 5; code.extra[25] := 5; code.extra[26] := 5; code.extra[27] := 5;
			code.extra[28] := 0; code.extra[29] := 112; code.extra[30] := 112;
			code.base[0] := 3; code.base[1] := 4; code.base[2] := 5; code.base[3] := 6;
			code.base[4] := 7; code.base[5] := 8; code.base[6] := 9; code.base[7] := 10;
			code.base[8] := 11; code.base[9] := 13; code.base[10] := 15; code.base[11] := 17;
			code.base[12] := 19; code.base[13] := 23; code.base[14] := 27; code.base[15] := 31;
			code.base[16] := 35; code.base[17] := 43; code.base[18] := 51; code.base[19] := 59;
			code.base[20] := 67; code.base[21] := 83; code.base[22] := 99; code.base[23] := 115;
			code.base[24] := 131; code.base[25] := 163; code.base[26] := 195; code.base[27] := 227;
			code.base[28] := 258; code.base[29] := 0; code.base[30] := 0
		END
	END MakeLitLenCode;
	
	PROCEDURE MakeDistCode (VAR code: Code; bits, offset, size, simple: INTEGER);
	BEGIN
		code.bits := bits; code.offset := offset; code.size := size; code.simple := simple;
		IF simple < size THEN
			code.extra[0] := 0; code.extra[1] := 0; code.extra[2] := 0; code.extra[3] := 0;
			code.extra[4] := 1; code.extra[5] := 1; code.extra[6] := 2; code.extra[7] := 2;
			code.extra[8] := 3; code.extra[9] := 3; code.extra[10] := 4; code.extra[11] := 4;
			code.extra[12] := 5; code.extra[13] := 5; code.extra[14] := 6; code.extra[15] := 6;
			code.extra[16] := 7; code.extra[17] := 7; code.extra[18] := 8; code.extra[19] := 8;
			code.extra[20] := 9; code.extra[21] := 9; code.extra[22] := 10; code.extra[23] := 10;
			code.extra[24] := 11; code.extra[25] := 11; code.extra[26] := 12; code.extra[27] := 12;
			code.extra[28] := 13; code.extra[29] := 13;
			code.base[0] := 1; code.base[1] := 2; code.base[2] := 3; code.base[3] := 4;
			code.base[4] := 5; code.base[5] := 7; code.base[6] := 9; code.base[7] := 13;
			code.base[8] := 17; code.base[9] := 25; code.base[10] := 33; code.base[11] := 49;
			code.base[12] := 65; code.base[13] := 97; code.base[14] := 129; code.base[15] := 193;
			code.base[16] := 257; code.base[17] := 385; code.base[18] := 513; code.base[19] := 769;
			code.base[20] := 1025; code.base[21] := 1537; code.base[22] := 2049; code.base[23] := 3073;
			code.base[24] := 4097; code.base[25] := 6145; code.base[26] := 8193; code.base[27] := 12289;
			code.base[28] := 16385; code.base[29] := 24577
		END
	END MakeDistCode;
	
	PROCEDURE MakeFixedLitLenCode (VAR len: Lengths; VAR code: Code);
		VAR i: LONGINT;
	BEGIN
		ASSERT(LEN(len) >= 288, 100);
		FOR i := 0 TO 143 DO len[i] := 8 END;
		FOR i := 144 TO 255 DO len[i] := 9 END;
		FOR i := 256 TO 279 DO len[i] := 7 END;
		FOR i := 280 TO 287 DO len[i] := 8 END;
		MakeLitLenCode(code, 9, 0, 288, 257)
	END MakeFixedLitLenCode;
	
	PROCEDURE MakeFixedDistCode (VAR len: Lengths; VAR code: Code);
		VAR i: LONGINT;
	BEGIN
		ASSERT(LEN(len) >= 30, 100);
		FOR i := 0 TO 29 DO len[i] := 5 END;
		MakeDistCode(code, 5, 0, 30, 0)
	END MakeFixedDistCode;
	
	(* build huffman tree for given code *)
	PROCEDURE BuildTree (VAR clen: Lengths; VAR code: Code; VAR tn: TreeNodes; VAR tree: Tree; VAR res: LONGINT);
		CONST
			maxLen = 15;	(* maximum bit length of any code *)
		VAR
			l, lbits, min, max, dbits, len, bits, b: LONGINT;	(* bit lengths *)
			c, idx: LONGINT;	(* code index *)
			codes: ARRAY maxLen+1 OF INTEGER;	(* number of codes of each length *)
			unused, size, count, entries: LONGINT;	(* code counts *)
			offset: ARRAY maxLen+1 OF INTEGER;	(* offset into index table for each length *)
			off: INTEGER;
			index: ARRAY MaxLitLenCodes OF INTEGER;	(* symbol numbers ordered by code length *)
			backup: ARRAY maxLen OF LONGINT;	(* projection of current pattern to each level *)
			pat, p, inc: LONGINT;	(* current code pattern *)
			tab, t: LONGINT;	(* pointers into Huffman nodes *)
			level: LONGINT;	(* current table level *)
			table: ARRAY maxLen OF LONGINT;	(* current table index for each open level *)
			node: Node;
	BEGIN
		(* compute number of codes for each bit length *)
		FOR l := 0 TO maxLen DO
			codes[l] := 0
		END;
		FOR c := 0 TO code.size - 1 DO
			INC(codes[clen[code.offset + c]])
		END;
		IF codes[0] = code.size THEN	(* all codes have len = 0 *)
			tree.node := NIL; tree.base := 0; tree.bits := 0; res := Ok;
			RETURN
		END;
		
		lbits := code.bits;	(* number of lookup bits *)
		l := 1; WHILE (l <= maxLen) & (codes[l] = 0) DO INC(l) END;
		min := l; IF lbits < min THEN lbits := SHORT(min) END;
		l := maxLen; WHILE (l > 0) & (codes[l] = 0) DO DEC(l) END;
		max := l; IF lbits > max THEN lbits := SHORT(max) END;
		tree.bits := SHORT(lbits);	(* adjusted number of lookup bits *)
		
		(* add number of unused codes to last code length count *)
		l := min; unused := ASH(1, min);
		LOOP
			DEC(unused, LONG(codes[l]));
			IF unused < 0 THEN res := DataError; RETURN END;	(* more codes for length requested than available *)
			IF l = max THEN EXIT END;
			INC(l); unused := 2*unused	(* can append either 0 or 1 to yet unused codes *)
		END;
		INC(codes[max], SHORT(unused));
		
		(* generate starting offsets into index table for each length *)
		l := 1; offset[1] := 0; off := 0;
		WHILE l < max DO
			INC(off, codes[l]); INC(l); offset[l] := off
		END;
		
		(* create index to code symbol ordered by code length *)
		FOR c := 0 TO code.size-1 DO
			l := clen[code.offset + c];
			IF l # 0 THEN
				index[offset[l]] := SHORT(c); INC(offset[l])
			END
		END;
		size := offset[max];	(* effective number of codes *)
		
		(* generate Huffman codes and tables for each level *)
		backup[0] := 0; pat := 0; idx := 0;
		dbits := -lbits; level := -1;	(* dbits = lookupBits * level (number of decoded bits) *)
		FOR len := min TO max DO
			count := codes[len];
			WHILE count > 0 DO
				WHILE len > dbits + lbits DO	(* code length too long to fit in current table *)
					INC(level); INC(dbits, lbits);	(* previous table had size tbits *)
					
					(* compute minimum size <= lookup bits for next table *)
					bits := max - dbits;
					IF bits > lbits THEN bits := lbits END;	(* limit number of bits for table *)
					b := len - dbits; entries := ASH(1, b);	(* try table with size len-dbits *)
					IF entries > count THEN
						(*
							codes of length len do not use all slots in table of length b. however, these unused slots
							will be used by longer codes having the same prefix.
						*)
						DEC(entries, count);
						IF b < bits THEN
							l := len;
							LOOP
								INC(b); IF b = bits THEN EXIT END;	(* mustn't make table any larger *)
								entries := 2*entries; INC(l);
								IF entries <= codes[l] THEN EXIT END;	(* enough codes to use up b bits *)
								DEC(entries, LONG(codes[l]))
							END
						END
					END;
					
					(* allocate table from available Huffman nodes *)
					entries := ASH(1, b);
					IF tn.next + entries > LEN(tn.node^) THEN
						res := MemError; RETURN
					END;
					tab := tn.next; table[level] := tab; INC(tn.next, entries);
					
					(* connect to previous table *)
					IF level > 0 THEN
						backup[level] := pat;	(* save pattern for backing up *)
						node.bits := SHORT(SHORT(lbits));	(* bits to dump before this table *)
						node.exop := OpBase + SHORT(SHORT(b));	(* bits in this table *)
						t := ASH(pat, -(dbits - lbits));	(* offset of pattern within previous table *)
						node.base := SHORT(tab - table[level-1] - t);	(* offset to this table *)
						tn.node[table[level-1] + t] := node	(* link previous table entry to this table *)
					ELSE
						tree.node := tn.node; tree.base := tab
					END
				END;
				
				(* set up table entry *)
				node.bits := SHORT(SHORT(len - dbits));
				IF idx >= size THEN
					node.exop := OpBase + OpSpecial + OpInvalid	(* out of codes *)
				ELSIF index[idx] < code.simple THEN	(* simple code *)
					IF index[idx] < 256 THEN node.exop := OpBase ELSE node.exop := OpBase + OpSpecial + OpEndBlock END;
					node.base := index[idx];	(* simple code is just the value *)
					INC(idx)
				ELSE	(* non-simple => lookup in extra/base tables *)
					node.exop := OpBase + OpSpecial + OpExtra + code.extra[index[idx] - code.simple];
					node.base := code.base[index[idx] - code.simple];
					INC(idx)
				END;
				
				(* fill all table entries having common relevant code bits *)
				p := ASH(pat, -dbits); inc := ASH(1, len - dbits); 
				WHILE p < entries DO
					tn.node[tab + p] := node; INC(p, inc)
				END;
				
				(* increment the code pattern (in reverse bit order) *)
				l := len-1;
				WHILE ODD(ASH(pat, -l)) DO	(* generates carry *)
					DEC(pat, ASH(1, l));	(* equivalent to xor since pat.l is set *)
					DEC(l)
				END;
				INC(pat, ASH(1, l));	(* equivalent to xor since pat.l is clear *)
				
				(* backup over finished tables *)
				WHILE pat MOD ASH(1, dbits) # backup[level] DO	(* entry in previous table no longer compatible with this table *)
					DEC(level); DEC(dbits, lbits)
				END;
				
				DEC(count)
			END
		END;
		
		IF (unused # 0) & (max # 1) THEN res := BufError	(* incomplete table *)
		ELSE res := Ok
		END
	END BuildTree;
	
	
	(*--- Auxiliary Routines ---*)
	
	(* copy as much as possible from sliding window to output buffer *)
	PROCEDURE Flush (VAR s: Stream);
		VAR n: LONGINT;
	BEGIN
		(* get number of bytes to copy *)
		IF s.read <= s.write THEN n := s.write - s.read
		ELSE n := WindowSize - s.read	(* first copy only up to end of window *)
		END;
		IF n > s.out.avail THEN n := s.out.avail END;
		IF n > 0 THEN
			IF s.res.code = BufError THEN s.res.code := Ok END;
			IF s.checkFn # NIL THEN	(* update output check sum *)
				s.check := s.checkFn(s.check, s.window^, s.read, n)
			END;
			
			(* copy from window to output buffer *)
			ZlibBuffers.WriteBytes(s.out, s.window^, s.read, n);
			INC(s.read, n)
		END;
		
		IF s.read = WindowSize THEN	(* wrap read/write index and continue at start of window *)
			s.read := 0;
			IF s.write = WindowSize THEN s.write := 0 END;
			
			(* get number of bytes to copy *)
			n := s.write - s.read;
			IF n > s.out.avail THEN n := s.out.avail END;
			IF n > 0 THEN
				IF s.res.code = BufError THEN s.res.code := Ok END;
				IF s.checkFn # NIL THEN	(* update output check sum *)
					s.check := s.checkFn(s.check, s.window^, s.read, n)
				END;
				
				(* copy from window to output buffer *)
				ZlibBuffers.WriteBytes(s.out, s.window^, s.read, n);
				INC(s.read, n)
			END
		END
	END Flush;
	
	(* transfer bits from input buffer to bit buffer and return if successful *)
	PROCEDURE Need (VAR s: Stream; bits: LONGINT): BOOLEAN;
		VAR byte: CHAR;
	BEGIN
		WHILE s.bits < bits DO
			IF s.in.avail = 0 THEN
				Flush(s);
				RETURN FALSE
			END;
			ZlibBuffers.Read(s.in, byte);
			INC(s.buf, ASH(ORD(byte), s.bits)); INC(s.bits, 8)	(* one byte more in buffer now *)
		END;
		RETURN TRUE
	END Need;
	
	PROCEDURE Dump (VAR s: Stream; bits: LONGINT);
	BEGIN
		s.buf := SYSTEM.LSH(s.buf, -bits); DEC(s.bits, bits)
	END Dump;
	
	PROCEDURE NeedOut (VAR s: Stream; VAR wavail: LONGINT): BOOLEAN;
	BEGIN
		IF wavail = 0 THEN
			IF (s.write = WindowSize) & (s.read # 0) THEN
				s.write := 0; wavail := s.read-1
			END;
			IF wavail = 0 THEN
				Flush(s);
				IF (s.write = WindowSize) & (s.read # 0) THEN
					s.write := 0; wavail := s.read-1;
				END;
				IF wavail = 0 THEN
					RETURN FALSE
				END
			END
		END;
		RETURN TRUE
	END NeedOut;
	
	
	(*--- Codes ---*)
	
	PROCEDURE NewCodes (VAR s: Stream; VAR lltree, dtree: Tree);
	BEGIN
		s.decode.lltree := lltree; s.decode.dtree := dtree;
		s.decode.state := CodeStart
	END NewCodes;
	
	PROCEDURE FreeCodes (VAR s: Stream);
	BEGIN
		s.decode.lltree.node := NIL; s.decode.dtree.node := NIL; s.decode.tree.node := NIL
	END FreeCodes;
	
	(* Called with number of bytes left to write in window (wavail) at least 258 (the maximum 
		string length) and number of input bytes available (s.in.avail) at least ten.  The ten bytes 
		are six bytes for the longest length/distance pair plus four bytes for overloading the bit buffer. *)
	PROCEDURE InflateFast (VAR s: Stream; VAR wavail: LONGINT);
		VAR inavail, base, len, dist, index: LONGINT; byte: CHAR; node: Node; exop: INTEGER;
	BEGIN
		inavail := s.in.avail;
		REPEAT
			WHILE s.bits < 20 DO	(* maximal bits for lit/len code, including extra bits *)
				ZlibBuffers.Read(s.in, byte);
				INC(s.buf, ASH(ORD(byte), s.bits)); INC(s.bits, 8)
			END;
			base := s.decode.lltree.base; node.base := 0; exop := s.decode.lltree.bits;
			REPEAT
				base := base + node.base + s.buf MOD ASH(1, exop);
				node := s.decode.lltree.node[base];
				Dump(s, node.bits);
				exop := LONG(node.exop) - OpBase
			UNTIL (exop = 0) OR ODD(exop DIV OpSpecial);
			IF exop = 0 THEN	(* literal *)
				s.window[s.write] := CHR(node.base); INC(s.write); DEC(wavail)
			ELSIF ODD(exop DIV OpExtra) THEN	(* length code *)
				exop := exop MOD OpExtra;
				len := node.base + s.buf MOD ASH(1, exop);
				Dump(s, exop);
				WHILE s.bits < 15 DO	(* maximal bits for distance code *)
					ZlibBuffers.Read(s.in, byte);
					INC(s.buf, ASH(ORD(byte), s.bits)); INC(s.bits, 8)
				END;
				base := s.decode.dtree.base; node.base := 0; exop := s.decode.dtree.bits;
				REPEAT
					base := base + node.base + s.buf MOD ASH(1, exop);
					node := s.decode.dtree.node[base];
					Dump(s, node.bits);
					exop := LONG(node.exop) - OpBase
				UNTIL ODD(exop DIV OpSpecial);
				IF ODD(exop DIV OpExtra) THEN	(* distance code *)
					exop := exop MOD OpExtra;
					WHILE s.bits < exop DO	(* need up to 13 extra bits *)
						ZlibBuffers.Read(s.in, byte);
						INC(s.buf, ASH(ORD(byte), s.bits)); INC(s.bits, 8)
					END;
					dist := node.base + s.buf MOD ASH(1, exop);
					Dump(s, exop);
					DEC(wavail, len);
					index := s.write - dist;
					IF index < 0 THEN
						IF -index < len THEN	(* crosses window bounds *)
							INC(len, index);
							IF s.write - index <= WindowSize + index THEN	(* no overlap *)
								SYSTEM.MOVE(SYSTEM.ADR(s.window[WindowSize + index]), SYSTEM.ADR(s.window[s.write]), -index);
								DEC(s.write, index)
							ELSE	(* be safe *)
								index := WindowSize + index;
								REPEAT
									s.window[s.write] := s.window[index]; INC(s.write); INC(index)
								UNTIL index = WindowSize
							END;
							index := 0
						ELSE
							INC(index, WindowSize)
						END
					END;
					IF len > 0 THEN
						IF index + len <= s.write THEN	(* no overlap *)
							SYSTEM.MOVE(SYSTEM.ADR(s.window[index]), SYSTEM.ADR(s.window[s.write]), len);
							INC(s.write, len);
						ELSE
							REPEAT
								s.window[s.write] := s.window[index]; INC(s.write); INC(index);
								DEC(len)
							UNTIL len = 0
						END
					END
				ELSE
					SetMsg(s.res, "invalid distance code"); s.res.code := DataError;
					len := inavail - s.in.avail;
					IF s.bits DIV 8 < len THEN len := s.bits DIV 8 END;
					ZlibBuffers.Reread(s.in, len); DEC(s.bits, 8*len); s.buf := s.buf MOD ASH(1, s.bits);
					RETURN
				END
			ELSE
				len := inavail - s.in.avail;
				IF s.bits DIV 8 < len THEN len := s.bits DIV 8 END;
				ZlibBuffers.Reread(s.in, len); DEC(s.bits, 8*len); s.buf := s.buf MOD ASH(1, s.bits);
				IF ODD(exop DIV OpEndBlock) THEN s.res.code := StreamEnd
				ELSE SetMsg(s.res, "invalid literal/length code"); s.res.code := DataError
				END;
				RETURN
			END
		UNTIL (wavail < 258) OR (s.in.avail < 10);
		
		(* can no longer guarantee enough space *)
		len := inavail - s.in.avail;
		IF s.bits DIV 8 < len THEN len := s.bits DIV 8 END;
		ZlibBuffers.Reread(s.in, len); DEC(s.bits, 8*len); s.buf := s.buf MOD ASH(1, s.bits);
		s.res.code := Ok
	END InflateFast;
	
	PROCEDURE InflateCodes (VAR s: Stream);
		VAR wavail, base, index: LONGINT; node: Node; exop: INTEGER;
	BEGIN
		IF s.write < s.read THEN wavail := s.read - s.write - 1
		ELSE wavail := WindowSize - s.write
		END;
		LOOP
			CASE s.decode.state OF
			| CodeStart:	(* try fast inflation while enough space available *)
				IF (wavail >= 258) & (s.in.avail >= 10) THEN
					InflateFast(s, wavail);
					IF s.res.code # Ok THEN
						IF s.res.code = StreamEnd THEN s.decode.state := CodeWash
						ELSE s.decode.state := CodeBad
						END;
						EXIT
					END
				END;
				s.decode.tree := s.decode.lltree;
				s.decode.state := CodeLen
			
			| CodeLen:	(* get literal/length code *)
				IF ~Need(s, s.decode.tree.bits) THEN EXIT END;
				base := s.decode.tree.base + s.buf MOD ASH(1, s.decode.tree.bits);
				node := s.decode.tree.node[base];
				Dump(s, node.bits);
				exop := LONG(node.exop) - OpBase;
				IF exop = 0 THEN	(* literal *)
					s.decode.lit := node.base;
					s.decode.state := CodeLit
				ELSIF ODD(exop DIV OpExtra) THEN	(* need extra bits *)
					s.decode.extra := exop MOD OpExtra;
					s.decode.len := node.base;
					s.decode.state := CodeLenExt
				ELSIF ~ODD(exop DIV OpSpecial) THEN	(* hop to next table *)
					s.decode.tree.bits := exop;
					s.decode.tree.base := base + node.base
				ELSIF ODD(exop DIV OpEndBlock) THEN	(* end of block *)
					s.decode.state := CodeWash
				ELSE	(* invalid code *)
					SetMsg(s.res, "invalid literal/length code");
					s.res.code := DataError; s.decode.state := CodeBad;
					Flush(s);
					EXIT
				END
			
			| CodeLenExt:	(* get extra bits for length codes *)
				IF ~Need(s, s.decode.extra) THEN EXIT END;
				INC(s.decode.len, SHORT(s.buf MOD ASH(1, s.decode.extra)));
				Dump(s, s.decode.extra);
				s.decode.tree := s.decode.dtree;
				s.decode.state := CodeDist
			
			| CodeDist:	(* get distance code *)
				IF ~Need(s, s.decode.tree.bits) THEN EXIT END;
				base := s.decode.tree.base + s.buf MOD ASH(1, s.decode.tree.bits);
				node := s.decode.tree.node[base];
				Dump(s, node.bits);
				exop := LONG(node.exop) - OpBase;
				IF ODD(exop DIV OpExtra) THEN	(* need extra bits *)
					s.decode.extra := exop MOD OpExtra;
					s.decode.dist := node.base;
					s.decode.state := CodeDistExt
				ELSIF ~ODD(exop DIV OpSpecial) THEN	(* need more bits *)
					s.decode.tree.bits := exop;
					s.decode.tree.base := base + node.base
				ELSE	(* invalid code *)
					SetMsg(s.res, "invalid distance code");
					s.res.code := DataError; s.decode.state := CodeBad;
					Flush(s);
					EXIT
				END
			
			| CodeDistExt:	(* get extra bits for distance *)
				IF ~Need(s, s.decode.extra) THEN EXIT END;
				INC(s.decode.dist, SHORT(s.buf MOD ASH(1, s.decode.extra)));
				Dump(s, s.decode.extra);
				s.decode.state := CodeCopy
			
			| CodeCopy:	(* copy within window *)
				index := (s.write - s.decode.dist) MOD WindowSize;	(* position of string to copy *)
				WHILE s.decode.len # 0 DO
					IF ~NeedOut(s, wavail) THEN EXIT END;
					s.window[s.write] := s.window[index]; INC(s.write); DEC(wavail);
					index := (index+1) MOD WindowSize;
					DEC(s.decode.len)
				END;
				s.decode.state := CodeStart
			
			| CodeLit:	(* append literal to window *)
				IF ~NeedOut(s, wavail) THEN EXIT END;
				s.window[s.write] := CHR(s.decode.lit); INC(s.write); DEC(wavail);
				s.decode.state := CodeStart
			
			| CodeWash:	(* block finished but window may not be empty *)
				IF s.bits > 7 THEN	(* return unused byte, if any *)
					ASSERT(s.bits < 16, 110);	(* otherwise InflateCodes grabbed too many bytes *)
					DEC(s.bits, 8); s.buf := s.buf MOD ASH(1, s.bits);
					ZlibBuffers.Reread(s.in, 1)
				END;
				Flush(s);
				IF s.read # s.write THEN EXIT
				ELSE s.decode.state := CodeEnd
				END
			
			| CodeEnd:
				s.res.code := StreamEnd;
				EXIT
			
			| CodeBad:
				s.res.code := DataError;
				EXIT
			
			ELSE
				s.res.code := StreamError;
				EXIT
			END
		END
	END InflateCodes;
	
	
	(*--- Block Handling ---*)
	
	PROCEDURE ResetBlocks (VAR s: Stream; VAR check: LONGINT);
		VAR buf: ARRAY 1 OF CHAR;
	BEGIN
		check := s.check;
		s.block.state := BlkType; s.buf := 0; s.bits := 0;
		s.read := 0; s.write := 0;
		IF s.checkFn # NIL THEN
			s.check := s.checkFn(0, buf, 0, -1)
		END
	END ResetBlocks;
	
	PROCEDURE NewBlocks (VAR s: Stream; checkFn: CheckFunc);
	BEGIN
		NEW(s.block.nodes, MaxNodes); NEW(s.window);
		IF (s.block.nodes = NIL) OR (s.window = NIL) THEN
			s.block.nodes := NIL; s.window := NIL;
			s.res.code := MemError
		ELSE
			s.checkFn := checkFn;
			ResetBlocks(s, s.check);
			s.res.code := Ok
		END
	END NewBlocks;
	
	PROCEDURE FreeBlocks (VAR s: Stream);
	BEGIN
		ResetBlocks(s, s.check);
		s.block.nodes := NIL; s.window := NIL
	END FreeBlocks;
	
	PROCEDURE InflateBlocks (VAR s: Stream);
		VAR
			wavail, t, cnt, len: LONGINT; tn: TreeNodes; clen: ARRAY MaxLitLenCodes OF SHORTINT; code: Code; res: LONGINT;
			node: Node; lltree, dtree: Tree;
	BEGIN
		IF s.write < s.read THEN wavail := s.read - s.write - 1
		ELSE wavail := WindowSize - s.write
		END;
		LOOP
			CASE s.block.state OF
			| BlkType:	(* begin of block, determine if last and compression method *)
				IF ~Need(s, 3) THEN EXIT END;
				t := s.buf MOD 8; s.block.last := ODD(t);
				Dump(s, 3);
				CASE t DIV 2 OF
				| 0: (* no compression *)
					Dump(s, s.bits MOD 8);	(* go to byte boundary *)
					s.block.state := BlkLens
				| 1: (* compressed with fixed Huffman codes *)
					IF ~FixedBuilt THEN
						NEW(tn.node, MaxFixedNodes); tn.next := 0;
						MakeFixedLitLenCode(clen, code);
						BuildTree(clen, code, tn, FixedLitLenTree, res);
						ASSERT(res = Ok, 110);
						MakeFixedDistCode(clen, code);
						BuildTree(clen, code, tn, FixedDistTree, res);
						ASSERT((res = Ok) OR (res = BufError), 111);	(* allow incomplete code *)
						FixedBuilt := TRUE
					END;
					NewCodes(s, FixedLitLenTree, FixedDistTree);
					s.block.state := BlkCodes
				| 2: (* compressed with dynamic codes *)
					s.block.state := BlkTable
				| 3: (* illegal *)
					SetMsg(s.res, "invalid block type");
					s.block.state := BlkBad; s.res.code := DataError;
					Flush(s);
					EXIT
				END
			
			| BlkLens:	(* read length of uncompressed block *)
				IF ~Need(s, 32) THEN EXIT END;
				IF ASH(-(s.buf+1), -16) MOD 10000H # s.buf MOD 10000H THEN
					SetMsg(s.res, "invalid stored block lengths");
					s.block.state := BlkBad; s.res.code := DataError;
					Flush(s);
					EXIT
				END;
				s.block.left := s.buf MOD 10000H;
				s.buf := 0; s.bits := 0;	(* dump all bits *)
				IF s.block.left # 0 THEN s.block.state := BlkStored;
				ELSIF s.block.last THEN s.block.state := BlkDry
				ELSE s.block.state := BlkType
				END
			
			| BlkStored:	(* copy uncompressed bytes from input buffer to window *)
				IF s.in.avail = 0 THEN
					Flush(s);
					EXIT
				END;
				IF ~NeedOut(s, wavail) THEN EXIT END;
				t := s.block.left;
				IF t > s.in.avail THEN t := s.in.avail END;
				IF t > wavail THEN t := wavail END;
				IF s.write + t > WindowSize THEN t := WindowSize - s.write END;	(* new, not in original ZLIB source code *)
				IF t > 0 THEN
					ZlibBuffers.ReadBytes(s.in, s.window^, s.write, t)
				ELSE	(* new, not in original ZLIB source code *)
					Flush(s);
					EXIT
				END;
				INC(s.write, t); DEC(wavail, t);
				DEC(s.block.left, t);
				IF s.block.left = 0 THEN
					IF s.block.last THEN s.block.state := BlkDry
					ELSE s.block.state := BlkType
					END
				END
			
			| BlkTable:	(* get number of code lengths for each tree *)
				IF ~Need(s, 14) THEN EXIT END;	(* 5 (#lit/len-257) + 5 (#dist-1) + 4 (#codelen-4) *)
				t := s.buf MOD 4000H;
				s.block.nlit := SHORT(257 + t MOD 20H); t := t DIV 20H;
				s.block.ndist := SHORT(SHORT(1 + t MOD 20H)); t := t DIV 20H;
				s.block.nclen := SHORT(SHORT(4 + t));
				IF (s.block.nlit > 286) OR (s.block.ndist > 30) THEN
					SetMsg(s.res, "too many length or distance symbols");
					s.block.state := BlkBad; s.res.code := DataError;
					Flush(s);
					EXIT
				END;
				Dump(s, 14);
				s.block.index := 0;
				s.block.state := BlkBTree	(* ready to read code lengths *)
			
			| BlkBTree:	(* get code lengths for code length tree *)
				WHILE s.block.index < s.block.nclen DO	(* get bit lengths of code *)
					IF ~Need(s, 3) THEN EXIT END;
					s.block.clen[Order[s.block.index]] := SHORT(SHORT(s.buf MOD 8));
					INC(s.block.index);
					Dump(s, 3)
				END;
				WHILE s.block.index < 19 DO
					s.block.clen[Order[s.block.index]] := 0;
					INC(s.block.index)
				END;
				tn.node := s.block.nodes; tn.next := 0;
				code.bits := 7; code.offset := 0; code.size := 19; code.simple := 19;
				BuildTree(s.block.clen, code, tn, s.block.btree, res);
				IF res = DataError THEN
					SetMsg(s.res, "oversubscribed dynamic bit lengths tree");
					s.block.state := BlkBad
				ELSIF (res = BufError) OR (s.block.btree.bits = 0) THEN
					SetMsg(s.res, "incomplete dynamic bit lengths tree");
					res := DataError; s.block.state := BlkBad
				END;
				IF res # Ok THEN
					s.res.code := res;
					Flush(s);
					EXIT
				END;
				s.block.index := 0;
				s.block.state := BlkDTree	(* can now decode lit/len and distance code lengths *)
			
			| BlkDTree:	(* get code lengths for literal/length and distance trees *)
				WHILE s.block.index < s.block.nlit + s.block.ndist DO
					IF ~Need(s, s.block.btree.bits) THEN EXIT END;
					t := s.block.btree.base + s.buf MOD ASH(1, s.block.btree.bits);
					node := s.block.btree.node[t];
					IF node.base < 16 THEN	(* code length *)
						Dump(s, node.bits);
						s.block.clen[s.block.index] := SHORT(node.base);
						INC(s.block.index)
					ELSE
						CASE node.base OF
						| 16:	(* repeat previous length 3-6 times, using another 2 bits *)
							IF ~Need(s, node.bits+2) THEN EXIT END;
							Dump(s, node.bits); cnt := 3 + s.buf MOD 4; Dump(s, 2);
							IF s.block.index = 0 THEN
								SetMsg(s.res, "invalid bit length repeat (no previous code length)");
								s.res.code := DataError; s.block.state := BlkBad;
								Flush(s);
								EXIT
							END;
							len := s.block.clen[s.block.index-1]
						| 17:	(* repeat code length 0 for 3-10 times, using another 3 bits *)
							IF ~Need(s, node.bits+3) THEN EXIT END;
							Dump(s, node.bits); cnt := 3 + s.buf MOD 8; Dump(s, 3); len := 0
						| 18:	(* repeat code length 0 for 11-138 times, using another 7 bits *)
							IF ~Need(s, node.bits+7) THEN EXIT END;
							Dump(s, node.bits); cnt := 11 + s.buf MOD 128; Dump(s, 7); len := 0
						END;
						IF s.block.index + cnt > s.block.nlit + s.block.ndist THEN
							SetMsg(s.res, "invalid bit length repeat");
							s.res.code := DataError; s.block.state := BlkBad;
							Flush(s);
							EXIT
						END;
						REPEAT
							s.block.clen[s.block.index] := SHORT(SHORT(len));
							INC(s.block.index); DEC(cnt)
						UNTIL cnt = 0
					END
				END;
				
				(* build dynamic trees for literal/length and distance codes *)
				tn.node := s.block.nodes; tn.next := 0;
				MakeLitLenCode(code, 9, 0, s.block.nlit, 257);
				BuildTree(s.block.clen, code, tn, lltree, res);
				IF (res # Ok) OR (lltree.bits = 0) THEN
					IF res = DataError THEN
						SetMsg(s.res, "oversubscribed literal/length tree")
					ELSIF res # MemError THEN
						SetMsg(s.res, "incomplete literal/length tree"); res := DataError
					END
				ELSE
					MakeDistCode(code, 6, s.block.nlit, s.block.ndist, 0);
					BuildTree(s.block.clen, code, tn, dtree, res);
					IF (res # Ok) OR (dtree.bits = 0) & (s.block.nlit > 257) THEN
						IF res = DataError THEN
							SetMsg(s.res, "oversubscribed distance tree")
						ELSIF res = BufError THEN
							SetMsg(s.res, "incomplete distance tree"); res := DataError
						ELSIF res # MemError THEN
							SetMsg(s.res, "empty distance tree with lengths"); res := DataError
						END
					END
				END;
				IF res # Ok THEN
					IF res = DataError THEN s.block.state := BlkBad END;
					s.res.code := res;
					Flush(s);
					EXIT
				END;
				NewCodes(s, lltree, dtree);
				s.block.state := BlkCodes
			
			| BlkCodes:	(* decompress input bits using current codes *)
				InflateCodes(s);
				IF s.res.code # StreamEnd THEN
					Flush(s);
					EXIT
				END;
				s.res.code := Ok;
				FreeCodes(s);
				IF s.block.last THEN s.block.state := BlkDry
				ELSE s.block.state := BlkType
				END
			
			| BlkDry:	(* run out of input, waiting for output buffer to become empty *)
				Flush(s);
				IF s.read # s.write THEN EXIT END;
				s.block.state := BlkDone
			
			| BlkDone:	(* nothing more to do *)
				s.res.code := StreamEnd;
				EXIT
			
			| BlkBad:	(* error in data *)
				s.res.code := DataError;
				EXIT
			
			ELSE	(* programming error *)
				s.res.code := StreamError;
				EXIT
			END
		END
	END InflateBlocks;
	
	PROCEDURE SetBlockDict (VAR s: Stream; VAR dict: ARRAY OF CHAR; offset, len: LONGINT);
	BEGIN
		ASSERT((len <= WindowSize) & (offset + len <= LEN(dict)), 100);
		SYSTEM.MOVE(SYSTEM.ADR(dict[0]), SYSTEM.ADR(s.window[0]), len);
		s.read := len; s.write := len
	END SetBlockDict;
	
	PROCEDURE BlockSyncPoint (VAR s: Stream): BOOLEAN;
	BEGIN
		RETURN s.block.state = BlkLens
	END BlockSyncPoint;
	
	
	(*--- Inflate Streams ---*)
	
	PROCEDURE Reset0(VAR stream: Stream);
			VAR check: LONGINT;
	BEGIN
		IF stream.open THEN
			stream.res.msg := NIL;
			IF stream.wrapper THEN stream.inf.state := InfMethod ELSE stream.inf.state := InfBlocks END;
			ResetBlocks(stream, check);
			stream.res.code := Ok
		ELSE
			stream.res.code := StreamError
		END
	END Reset0;
	
	(** reset an opened inflate stream (equivalent to closing and reopening) **)
	PROCEDURE Reset* (VAR stream: Stream);
	BEGIN
		Reset0(stream);
		IF stream.open THEN
			ZlibBuffers.Reset(stream.in); ZlibBuffers.Reset(stream.out);
		END
	END Reset;
	
	(** initialize inflate stream; if 'wrapper' is not set, the stream has no zlib header and no checksum **)
	PROCEDURE Open* (VAR stream: Stream; wrapper: BOOLEAN);
		VAR checkFn: CheckFunc;
	BEGIN
		stream.res.msg := NIL;
		stream.wrapper := wrapper; stream.open := TRUE;
		IF wrapper THEN checkFn := Zlib.Adler32 ELSE checkFn := NIL END;
		NewBlocks(stream, checkFn);
		IF stream.res.code = Ok THEN
			Reset(stream)
		END
	END Open;
	
	(** close inflate stream **)
	PROCEDURE Close* (VAR stream: Stream);
	BEGIN
		FreeBlocks(stream);
		stream.res.code := Ok
	END Close;
	
	(** inflate until either input or output buffer runs out; if op is 'Finish', Inflate returns with either 'StreamEnd' or an error **)
	PROCEDURE Inflate* (VAR stream: Stream; flush: SHORTINT);
		VAR res: LONGINT; byte: CHAR; (* inxt, onxt: LONGINT; *)
	BEGIN
		IF ~stream.open THEN
			stream.res.code := StreamError
		ELSE
			IF flush = Finish THEN res := BufError	(* must never run out of buffer space *)
			ELSE res := Ok	(* can return anytime if some progress has been made *)
			END;
			stream.res.code := BufError;	(* set result code for case that no progress can be done *)
			LOOP
				IF stream.inf.state IN {InfMethod, InfFlag, InfDict4..InfDict1, InfCheck4..InfCheck1} THEN	(* need byte *)
					IF stream.in.avail = 0 THEN EXIT END;
					stream.res.code := res;
					ZlibBuffers.Read(stream.in, byte);
				END;
				CASE stream.inf.state OF
				| InfMethod:	(* get compression method and number of window bits *)
					stream.inf.method := ORD(byte);
					IF stream.inf.method MOD 10H # DeflateMethod THEN
						stream.inf.state := InfBad; stream.inf.marker := 5;	(* can't sync *)
						SetMsg(stream.res, "unknown compression method")
					ELSIF stream.inf.method DIV 10H + 8 > WindowBits THEN
						stream.inf.state := InfBad; stream.inf.marker := 5;	(* can't sync *)
						SetMsg(stream.res, "invalid window size")
					ELSE
						stream.inf.state := InfFlag
					END
				| InfFlag:	(* get flag byte *)
					IF (ASH(stream.inf.method, 8) + ORD(byte)) MOD 31 # 0 THEN
						stream.inf.state := InfBad; stream.inf.marker := 5;	(* can't sync *)
						SetMsg(stream.res, "incorrect header check")
					ELSIF ODD(ORD(byte) DIV PresetDict) THEN
						stream.inf.state := InfDict4
					ELSE
						stream.inf.state := InfBlocks
					END
				
				| InfDict4:	(* getting first byte of dictionary checksum *)
					stream.inf.check.stored := ASH(ORD(byte), 24);
					stream.inf.state := InfDict3
				| InfDict3:	(* getting second byte of dictionary checksum *)
					INC(stream.inf.check.stored, ASH(ORD(byte), 16));
					stream.inf.state := InfDict2
				| InfDict2:	(* getting third byte of dictionary checksum *)
					INC(stream.inf.check.stored, ASH(ORD(byte), 8));
					stream.inf.state := InfDict1
				| InfDict1:	(* getting final byte of dictionary checksum *)
					INC(stream.inf.check.stored, LONG(ORD(byte)));
					stream.inf.state := InfDict0;
					stream.res.code := NeedDict;
					EXIT
				| InfDict0:	(* client didn't provide dictionary as requested *)
					stream.inf.state := InfBad; stream.inf.marker := 0;	(* can try sync *)
					SetMsg(stream.res, "need dictionary");
					stream.res.code := StreamError;
					EXIT
				
				| InfBlocks:	(* decoding blocks *)
					(* inxt := stream.in.next; onxt := stream.out.next; *)
					InflateBlocks(stream);
					(* INC(stream.totalIn, stream.in.next - inxt); INC(stream.totalOut, stream.out.next - onxt); *)
					IF stream.res.code = DataError THEN
						stream.inf.state := InfBad; stream.inf.marker := 0	(* can try sync *)
					ELSIF stream.res.code = StreamEnd THEN
						stream.res.code := res;
						ResetBlocks(stream, stream.inf.check.calc);
						IF stream.wrapper THEN stream.inf.state := InfCheck4
						ELSE stream.inf.state := InfDone
						END
					ELSE
						IF stream.res.code = Ok THEN stream.res.code := res END;
						EXIT
					END
				
				| InfCheck4:	(* get first byte of checksum *)
					stream.inf.check.stored := ASH(ORD(byte), 24);
					stream.inf.state := InfCheck3
				| InfCheck3:	(* get second byte of checksum *)
					INC(stream.inf.check.stored, ASH(ORD(byte), 16));
					stream.inf.state := InfCheck2
				| InfCheck2:	(* get third byte of checksum *)
					INC(stream.inf.check.stored, ASH(ORD(byte), 8));
					stream.inf.state := InfCheck1
				| InfCheck1:	(* get final byte of checksum *)
					INC(stream.inf.check.stored, LONG(ORD(byte)));
					IF stream.inf.check.stored # stream.inf.check.calc THEN
						stream.inf.state := InfBad; stream.inf.marker := 5;	(* can't sync *)
						SetMsg(stream.res, "incorrect data check")
					ELSE
						stream.inf.state := InfDone
					END
				
				| InfDone:	(* nothing more to do *)
					stream.res.code := StreamEnd;
					EXIT
				| InfBad:	(* error in stream *)
					stream.res.code := DataError;
					EXIT
				END
			END
		END
	END Inflate;
	
	(** set dictionary if inflate returned 'NeedDict' **)
	PROCEDURE SetDictionary* (VAR stream: Stream; VAR dict: ARRAY OF CHAR; dictLen: LONGINT);
		VAR len, idx: LONGINT;
	BEGIN
		IF stream.open & (stream.inf.state = InfDict0) THEN
			IF Zlib.Adler32(1, dict, 0, dictLen) = stream.inf.check.stored THEN
				len := dictLen; idx := 0;
				IF len >= WindowSize THEN
					len := WindowSize-1;
					idx := dictLen - len
				END;
				SetBlockDict(stream, dict, idx, len);
				stream.inf.state := InfBlocks;
				stream.res.code := Ok
			ELSE
				stream.res.code := DataError;
			END
		ELSE
			stream.res.code := StreamError
		END
	END SetDictionary;
	
	(** try to synchronize stream to end of block generated with 'SyncFlush' or 'FullFlush' **)
	PROCEDURE Sync* (VAR stream: Stream);
		VAR m: LONGINT; mark: ARRAY 4 OF CHAR; byte: CHAR;
	BEGIN
		IF ~stream.open THEN
			stream.res.code := StreamError
		ELSE
			IF stream.inf.state # InfBad THEN
				stream.inf.state := InfBad; stream.inf.marker := 0
			END;
			IF stream.in.avail = 0 THEN
				stream.res.code := BufError
			ELSE
				mark[0] := 0X; mark[1] := 0X; mark[2] := 0FFX; mark[3] := 0FFX;
				m := stream.inf.marker;
				WHILE (stream.in.avail > 0) & (m < 4) DO
					ZlibBuffers.Read(stream.in, byte);
					IF byte = mark[m] THEN INC(m)
					ELSIF byte = 0X THEN m := 0
					ELSE m := 4-m
					END;
				END;
				stream.inf.marker := SHORT(m);
				
				IF m # 4 THEN	(* need more characters in order to decide *)
					stream.res.code := DataError
				ELSE
					Reset0(stream);
					stream.inf.state := InfBlocks;
					stream.res.code := Ok
				END
			END
		END
	END Sync;
	
	(** return if inflate is currently at end of block generated with 'SyncFlush' or 'FullFlush' **)
	PROCEDURE SyncPoint* (VAR stream: Stream): BOOLEAN;
	BEGIN
		IF stream.open THEN
			RETURN BlockSyncPoint(stream)
		ELSE
			stream.res.code := StreamError;
			RETURN FALSE
		END
	END SyncPoint;
	
	(** uncompress complete stream and return output length in len **)
	PROCEDURE Uncompress* (VAR src, dst: ARRAY OF CHAR; srcoffset, srclen, dstoffset, dstlen: LONGINT; VAR len: LONGINT; VAR res: Result);
		VAR s: Stream;
	BEGIN
		ZlibBuffers.Init(s.in, src, srcoffset, srclen, srclen);
		ZlibBuffers.Init(s.out, dst, dstoffset, dstlen, dstlen);
		Open(s, TRUE);
		IF s.res.code = Ok THEN
			Inflate(s, Finish);
			IF s.res.code = StreamEnd THEN
				len := s.out.totalOut;
				Close(s);
				res := s.res
			ELSE
				res := s.res;
				IF res.code = Ok THEN res.code := BufError END;
				Close(s)
			END
		ELSE
			res := s.res
		END
	END Uncompress;
	

BEGIN
	FixedBuilt := FALSE;
	Order[0] := 16; Order[1] := 17; Order[2] := 18; Order[3] := 0; Order[4] := 8; Order[5] := 7; Order[6] := 9;
	Order[7] := 6; Order[8] := 10; Order[9] := 5; Order[10] := 11; Order[11] := 4; Order[12] := 12; Order[13] := 3;
	Order[14] := 13; Order[15] := 2; Order[16] := 14; Order[17] := 1; Order[18] := 15
END ZlibInflate.
