1 ! Copyright (C) 2009 Marc Fauconneau.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs byte-vectors combinators
4 combinators.smart compression.huffman fry hashtables io.binary
5 kernel literals locals math math.bitwise math.order math.ranges
6 sequences sorting memoize combinators.short-circuit byte-arrays ;
7 QUALIFIED-WITH: bitstreams bs
8 IN: compression.inflate
12 ERROR: bad-zlib-data ;
13 ERROR: bad-zlib-header ;
15 :: check-zlib-header ( data -- )
16 16 data bs:peek 2 >le be> 31 mod ! checksum
18 4 data bs:read 8 assert= ! compression method: deflate
19 4 data bs:read ! log2(max length)-8, 32K max
20 7 <= [ throw-bad-zlib-header ] unless
21 5 data bs:seek ! drop check bits
22 1 data bs:read 0 assert= ! dictionary - not allowed in png
23 2 data bs:seek ! compression level; ignore
26 CONSTANT: clen-shuffle { 16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15 }
28 : get-table ( values size -- table )
30 [ '[ _ push-at ] 2each ] keep
31 seq>> rest-slice [ natural-sort ] map ; inline
33 :: decode-huffman-tables ( bitstream -- tables )
34 5 bitstream bs:read 257 +
35 5 bitstream bs:read 1 +
36 4 bitstream bs:read 4 + clen-shuffle swap head
38 dup length [ 3 bitstream bs:read ] replicate
40 bitstream swap <huffman-decoder>
41 [ 2dup + ] dip swap :> k!
44 { [ dup 16 = ] [ 2 bitstream bs:read 3 + 2array ] }
45 { [ dup 17 = ] [ 3 bitstream bs:read 3 + 2array ] }
46 { [ dup 18 = ] [ 7 bitstream bs:read 11 + 2array ] }
49 dup array? [ dup second ] [ 1 ] if
51 ] [ ] produce swap suffix
53 dup { [ array? ] [ first 16 = ] } 1&& [
55 [ second 1 + swap <repetition> append ] bi*
60 [ dup array? [ second 0 <repetition> ] [ 1array ] if ] map concat
62 [ [ length>> iota ] [ ] bi get-table ] map ;
64 MEMO: static-huffman-tables ( -- obj )
66 0 143 [a,b] length [ 8 ] replicate
67 144 255 [a,b] length [ 9 ] replicate append
68 256 279 [a,b] length [ 7 ] replicate append
69 280 287 [a,b] length [ 8 ] replicate append
71 0 31 [a,b] length [ 5 ] replicate 2array
72 [ [ length>> iota ] [ ] bi get-table ] map ;
74 CONSTANT: length-table
76 3 4 5 6 7 8 9 10 11 13 15 17 19 23 27 31
77 35 43 51 59 67 83 99 115 131 163 195 227 258
82 1 2 3 4 5 7 9 13 17 25 33 49
83 65 97 129 193 257 385 513 769 1025 1537 2049 3073
84 4097 6145 8193 12289 16385 24577
87 : nth* ( n seq -- elt )
88 [ length 1 - swap - ] [ nth ] bi ; inline
90 :: inflate-lz77 ( seq -- byte-array )
91 1000 <byte-vector> :> bytes
94 [ first2 '[ _ 1 - bytes nth* bytes push ] times ]
99 :: inflate-huffman ( bitstream tables -- bytes )
100 bitstream tables [ <huffman-decoder> ] with map :> tables
102 tables first read1-huff2
107 dup 5 > [ throw-bad-zlib-data ] when
108 bitstream bs:read 2array
112 tables second read1-huff2
115 dup 2 - 2 /i dup 13 >
116 [ throw-bad-zlib-data ] when
117 bitstream bs:read 2array
124 dup array? [ first2 ] [ 0 ] if
125 [ 257 - length-table nth ] [ + ] bi*
127 dup array? [ first2 ] [ 0 ] if
128 [ dist-table nth ] [ + ] bi*
133 :: inflate-raw ( bitstream -- bytes )
135 16 bitstream bs:read :> len
136 16 bitstream bs:read :> nlen
139 len nlen + 16 >signed -1 assert=
142 bitstream byte-pos>> len +
143 bitstream bytes>> <slice>
144 len 8 * bitstream bs:seek ;
146 : inflate-dynamic ( bitstream -- array )
147 dup decode-huffman-tables inflate-huffman ;
149 : inflate-static ( bitstream -- array )
150 static-huffman-tables inflate-huffman ;
152 :: inflate-loop ( bitstream -- array )
153 [ 1 bitstream bs:read 0 = ] [
157 { 0 [ inflate-raw ] }
158 { 1 [ inflate-static ] }
159 { 2 [ inflate-dynamic ] }
160 { 3 [ throw-bad-zlib-data f ] }
162 ] [ produce ] keep call suffix concat ;
166 : zlib-inflate ( bytes -- bytes )
168 [ check-zlib-header ] [ inflate-loop ] bi