Source file : lzma-decoding.adb
1 -- LZMA.Decoding - Ada 95 translation of LzmaSpec.cpp, LZMA Reference Decoder 9.31
2 -- LzmaSpec.cpp : 2013-07-28 : Igor Pavlov : Public domain
3 ----------------
4 --
5 -- Rework in 2016 by G. de Montmollin.
6 -- - some confusing identifiers were changed:
7 -- mostly, "range" was renamed "width", various names for probability data
8 -- have been renamed "probs", different things called "pos" have been renamed
9 -- - the whole probability model has been encapsulated
10 -- - parts common to encoding were moved to the root LZMA package.
11
12 -- Legal licensing note:
13
14 -- Copyright (c) 2014 .. 2021 Gautier de Montmollin (maintainer of the Ada version)
15 -- SWITZERLAND
16
17 -- Permission is hereby granted, free of charge, to any person obtaining a copy
18 -- of this software and associated documentation files (the "Software"), to deal
19 -- in the Software without restriction, including without limitation the rights
20 -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
21 -- copies of the Software, and to permit persons to whom the Software is
22 -- furnished to do so, subject to the following conditions:
23
24 -- The above copyright notice and this permission notice shall be included in
25 -- all copies or substantial portions of the Software.
26
27 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
28 -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
29 -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
30 -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
31 -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
32 -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
33 -- THE SOFTWARE.
34
35 -- NB: this is the MIT License, as found on the site
36 -- http://www.opensource.org/licenses/mit-license.php
37
38 with Ada.Text_IO,
39 Ada.Unchecked_Deallocation;
40
41 package body LZMA.Decoding is
42
43 type Byte_buffer is array (UInt32 range <>) of Byte;
44 type p_Byte_buffer is access Byte_buffer;
45
46 type Out_Window is record
47 buf : p_Byte_buffer := null;
48 pos : UInt32 := 0;
49 size : UInt32;
50 is_full : Boolean := False;
51 total_pos : Unsigned := 0;
52 end record;
53
54 procedure Create (o : in out Out_Window; new_dictionary_size : UInt32) is
55 begin
56 o.buf := new Byte_buffer (0 .. new_dictionary_size - 1);
57 o.size := new_dictionary_size;
58 end Create;
59
60 type Range_Decoder is record
61 width : UInt32 := 16#FFFF_FFFF#; -- (*)
62 code : UInt32 := 0;
63 corrupted : Boolean := False;
64 end record;
65 -- (*) called "range" in LZMA spec and "remaining width" in G.N.N. Martin's
66 -- article about range encoding.
67
68 procedure Init (o : in out Range_Decoder) is
69 begin
70 if Read_Byte /= 0 then
71 o.corrupted := True;
72 end if;
73 for i in 0 .. 3 loop
74 o.code := Shift_Left (o.code, 8) or UInt32 (Read_Byte);
75 end loop;
76 if o.code = o.width then
77 o.corrupted := True;
78 end if;
79 end Init;
80
81 procedure Decode_Properties (o : in out LZMA_Decoder_Info; b : Byte_buffer) is
82 d : Unsigned := Unsigned (b (b'First));
83 begin
84 if d >= 9 * 5 * 5 then
85 raise LZMA_Error with "Incorrect LZMA properties";
86 end if;
87 o.lc := Literal_Context_Bits_Range (d mod 9);
88 d := d / 9;
89 o.lp := Literal_Position_Bits_Range (d mod 5);
90 o.pb := Position_Bits_Range (d / 5);
91 o.dictSizeInProperties := 0;
92 for i in 0 .. 3 loop
93 o.dictSizeInProperties := o.dictSizeInProperties +
94 UInt32 (b (UInt32 (i) + 1 + b'First)) * 2 ** (8 * i);
95 end loop;
96 o.dictionary_size := o.dictSizeInProperties;
97 if o.dictionary_size < Min_dictionary_size then
98 o.dictionary_size := Min_dictionary_size;
99 end if;
100 end Decode_Properties;
101
102 procedure Decode_Contents (o : in out LZMA_Decoder_Info; res : out LZMA_Result) is
103 state : State_range := 0;
104 -- Small stack of recent distances used for LZ. Required: initialized with zero values.
105 rep0, rep1, rep2, rep3 : UInt32 := 0;
106 pos_state : Pos_state_range;
107 -- Local copies of invariant properties.
108 is_unpack_size_defined : constant Boolean := o.unpackSizeDefined;
109 literal_pos_mask : constant UInt32 := 2 ** o.lp - 1;
110 lc : constant Literal_Context_Bits_Range := o.lc;
111 --
112 use type Data_Bytes_Count;
113 out_win : Out_Window;
114 -- Local range decoder
115 range_dec : Range_Decoder;
116 -- Entire probability model. Maximum lit_prob_index is: 3,145,727.
117 probs : All_probabilities (last_lit_prob_index => 16#300# * 2 ** (o.lc + o.lp) - 1);
118
119 -- Normalize corresponds to G.N.N. Martin's revised algorithm's adding of
120 -- trailing digits - for encoding. Here we decode and know the encoded
121 -- data, brought by Read_Byte.
122 procedure Normalize is
123 pragma Inline (Normalize);
124 begin
125 -- Assertion: the width is large enough for the normalization to be needed
126 -- once per bit decoding. Worst case: width = 2**24 before; bound = (2**13) * (2**5-1)
127 -- new width's (leading binary digit) = 2**17; after normalization: 2**(17+8) = 2**25.
128 if range_dec.width < width_threshold then
129 range_dec.width := Shift_Left (range_dec.width, 8);
130 range_dec.code := Shift_Left (range_dec.code, 8) or UInt32 (Read_Byte);
131 end if;
132 end Normalize;
133
134 procedure Decode_Bit (prob : in out CProb; symbol : out Unsigned) is
135 pragma Inline (Decode_Bit);
136 cur_prob : constant CProb := prob; -- Local copy
137 bound : constant UInt32 := Shift_Right (range_dec.width, probability_model_bits) * UInt32 (cur_prob);
138 -- See encoder for explanations about the maths.
139 begin
140 if range_dec.code < bound then
141 prob := cur_prob + Shift_Right (probability_model_count - cur_prob, probability_change_bits);
142 range_dec.width := bound;
143 Normalize;
144 symbol := 0;
145 else
146 prob := cur_prob - Shift_Right (cur_prob, probability_change_bits);
147 range_dec.code := range_dec.code - bound;
148 range_dec.width := range_dec.width - bound;
149 Normalize;
150 symbol := 1;
151 end if;
152 end Decode_Bit;
153
154 function Is_Empty return Boolean is
155 pragma Inline (Is_Empty);
156 begin
157 return out_win.pos = 0 and then not out_win.is_full;
158 end Is_Empty;
159
160 LZ77_Dump : Ada.Text_IO.File_Type;
161 some_trace : constant Boolean := False;
162
163 procedure Put_Byte (b : Byte) is
164 pragma Inline (Put_Byte);
165 begin
166 out_win.total_pos := out_win.total_pos + 1;
167 out_win.buf (out_win.pos) := b;
168 out_win.pos := out_win.pos + 1;
169 if out_win.pos = out_win.size then
170 out_win.pos := 0;
171 out_win.is_full := True;
172 end if;
173 Write_Byte (b);
174 if some_trace then
175 Ada.Text_IO.Put (LZ77_Dump, "Lit" & Byte'Image (b));
176 if b in 32 .. 126 then
177 Ada.Text_IO.Put (LZ77_Dump, " '" & Character'Val (b) & ''');
178 end if;
179 Ada.Text_IO.New_Line (LZ77_Dump);
180 end if;
181 end Put_Byte;
182
183 function Get_Byte (dist : UInt32) return Byte is
184 pragma Inline (Get_Byte);
185 begin
186 if dist <= out_win.pos then
187 return out_win.buf (out_win.pos - dist);
188 else
189 return out_win.buf (out_win.pos - dist + out_win.size);
190 end if;
191 end Get_Byte;
192
193 procedure Process_Literal is
194 pragma Inline (Process_Literal);
195 prev_byte : Byte := 0;
196 symbol : Unsigned := 1;
197 lit_state : Integer;
198 probs_idx : Integer;
199 bit_nomatch : Unsigned;
200 begin
201 if is_unpack_size_defined and then o.unpackSize = 0 then
202 raise LZMA_Error with "Decoded data will exceed expected data size (Process_Literal)";
203 end if;
204 --
205 if not Is_Empty then
206 prev_byte := Get_Byte (dist => 1);
207 end if;
208 lit_state :=
209 Integer (
210 Shift_Left (UInt32 (out_win.total_pos) and literal_pos_mask, lc) +
211 Shift_Right (UInt32 (prev_byte), 8 - lc)
212 );
213 probs_idx := 16#300# * lit_state;
214 if state < 7 then
215 loop
216 Decode_Bit (probs.lit (probs_idx + Integer (symbol)), bit_nomatch);
217 symbol := (2 * symbol) or bit_nomatch;
218 exit when symbol >= 16#100#;
219 end loop;
220 else
221 declare
222 --
223 -- The probabilities used for decoding this literal assume
224 -- that the current literal sequence resembles to the last
225 -- distance-length copied sequence.
226 --
227 match_byte : UInt32 := UInt32 (Get_Byte (dist => rep0 + 1));
228 match_bit : UInt32; -- either 0 or 16#100#
229 prob_idx_match : Integer; -- either 0 (normal case without match), 16#100# or 16#200#
230 bit_a, bit_b : Unsigned;
231 begin
232 loop
233 match_byte := match_byte + match_byte;
234 match_bit := match_byte and 16#100#;
235 prob_idx_match := Integer (16#100# + match_bit);
236 Decode_Bit (probs.lit (probs_idx + prob_idx_match + Integer (symbol)), bit_a);
237 symbol := (2 * symbol) or bit_a;
238 exit when symbol >= 16#100#;
239 if match_bit /= Shift_Left (UInt32 (bit_a), 8) then
240 -- No bit match, then give up byte match
241 loop
242 Decode_Bit (probs.lit (probs_idx + Integer (symbol)), bit_b);
243 symbol := (2 * symbol) or bit_b;
244 exit when symbol >= 16#100#;
245 end loop;
246 exit;
247 end if;
248 end loop;
249 end;
250 end if;
251 Put_Byte (Byte (symbol - 16#100#)); -- The output of a simple literal happens here.
252 --
253 state := Update_State_Literal (state);
254 o.unpackSize := o.unpackSize - 1;
255 end Process_Literal;
256
257 dict_size : constant UInt32 := o.dictionary_size;
258
259 function Is_Finished_OK return Boolean is
260 pragma Inline (Is_Finished_OK);
261 begin
262 return range_dec.code = 0;
263 end Is_Finished_OK;
264
265 type DL_Return_Code is (Normal, End_Of_Stream);
266
267 function Process_Distance_and_Length return DL_Return_Code is
268 pragma Inline (Process_Distance_and_Length);
269 --
270 procedure Bit_Tree_Decode (
271 prob : in out CProb_array;
272 num_bits : Positive;
273 m : out Unsigned)
274 is
275 pragma Inline (Bit_Tree_Decode);
276 a_bit : Unsigned;
277 begin
278 m := 1;
279 for count in reverse 1 .. num_bits loop
280 Decode_Bit (prob (Integer (m) + prob'First), a_bit);
281 m := 2 * m + a_bit;
282 end loop;
283 m := m - 2**num_bits;
284 end Bit_Tree_Decode;
285 --
286 len : Unsigned := 0;
287 --
288 procedure Copy_Match (dist : UInt32) is
289 pragma Inline (Copy_Match);
290 len32 : constant UInt32 := UInt32 (len);
291 -- Conversion to UInt64 needed for dictionary size > 2**32 - 273:
292 will_fill : constant Boolean :=
293 UInt64 (out_win.pos) + UInt64 (len32) >= UInt64 (out_win.size);
294 --
295 procedure Easy_case is
296 pragma Inline (Easy_case);
297 src_from, src_to : UInt32;
298 b1 : Byte;
299 begin
300 -- The src and dest slices are within circular buffer bounds.
301 -- May overlap (len32 > dist), even several times.
302 src_from := out_win.pos - dist;
303 src_to := out_win.pos - dist + len32 - 1;
304 -- We copy in forward order, with eventual overlapping(s)..
305 for i in src_from .. src_to loop
306 b1 := out_win.buf (i);
307 out_win.buf (i + dist) := b1;
308 Write_Byte (b1);
309 end loop;
310 out_win.pos := out_win.pos + len32;
311 end Easy_case;
312 --
313 procedure Modulo_case is
314 pragma Inline (Modulo_case);
315 b2, b3 : Byte;
316 begin
317 -- src starts below 0 or dest goes beyond size-1
318 for count in reverse 1 .. len loop
319 if dist <= out_win.pos then
320 b2 := out_win.buf (out_win.pos - dist);
321 out_win.buf (out_win.pos) := b2;
322 out_win.pos := out_win.pos + 1;
323 if out_win.pos = out_win.size then
324 out_win.pos := 0;
325 end if;
326 Write_Byte (b2);
327 else
328 b3 := out_win.buf (out_win.size - dist + out_win.pos);
329 out_win.buf (out_win.pos) := b3;
330 out_win.pos := out_win.pos + 1;
331 if out_win.pos = out_win.size then
332 out_win.pos := 0;
333 end if;
334 Write_Byte (b3);
335 end if;
336 end loop;
337 end Modulo_case;
338 begin
339 out_win.is_full := out_win.is_full or will_fill;
340 out_win.total_pos := out_win.total_pos + len;
341 if dist <= out_win.pos and not will_fill then
342 Easy_case;
343 else
344 Modulo_case;
345 end if;
346 if some_trace then
347 Ada.Text_IO.Put_Line (LZ77_Dump, "DLE" & UInt32'Image (dist) & Unsigned'Image (len));
348 end if;
349 end Copy_Match;
350 --
351 procedure Decode_Distance (dist : out UInt32) is
352 pragma Inline (Decode_Distance);
353 --
354 decode_direct : UInt32;
355 --
356 procedure Decode_Direct_Bits (num_bits : Natural) is
357 pragma Inline (Decode_Direct_Bits);
358 t : UInt32;
359 begin
360 decode_direct := 0;
361 for count in reverse 1 .. num_bits loop
362 range_dec.width := Shift_Right (range_dec.width, 1);
363 range_dec.code := range_dec.code - range_dec.width;
364 t := -Shift_Right (range_dec.code, 31);
365 range_dec.code := range_dec.code + (range_dec.width and t);
366 if range_dec.code = range_dec.width then
367 range_dec.corrupted := True;
368 end if;
369 Normalize;
370 decode_direct := decode_direct + decode_direct + t + 1;
371 end loop;
372 end Decode_Direct_Bits;
373 --
374 procedure Bit_Tree_Reverse_Decode (prob : in out CProb_array; num_bits : in Natural) is
375 pragma Inline (Bit_Tree_Reverse_Decode);
376 m : Unsigned := 1;
377 a_bit : Unsigned;
378 begin
379 for i in 0 .. num_bits - 1 loop
380 Decode_Bit (prob (Integer (m) + prob'First), a_bit);
381 m := 2 * m + a_bit;
382 dist := dist or Shift_Left (UInt32 (a_bit), i);
383 end loop;
384 end Bit_Tree_Reverse_Decode;
385 --
386 -- len has been set up previously by Decode_Length.
387 len_state : constant Unsigned := Unsigned'Min (len, len_to_pos_states - 1);
388 dist_slot : Unsigned;
389 numDirectBits : Natural;
390 --
391 begin -- Decode_Distance
392 Bit_Tree_Decode (probs.dist.slot_coder (len_state), Dist_slot_bits, dist_slot);
393 if dist_slot < Start_dist_model_index then
394 dist := UInt32 (dist_slot);
395 return;
396 end if;
397 numDirectBits := Natural (Shift_Right (UInt32 (dist_slot), 1) - 1);
398 dist := Shift_Left (2 or (UInt32 (dist_slot) and 1), numDirectBits);
399 if dist_slot < End_dist_model_index then
400 Bit_Tree_Reverse_Decode (
401 probs.dist.pos_coder (Integer (dist) - Integer (dist_slot) .. Pos_coder_range'Last),
402 numDirectBits
403 );
404 else
405 Decode_Direct_Bits (numDirectBits - align_bits);
406 dist := dist + Shift_Left (decode_direct, align_bits);
407 Bit_Tree_Reverse_Decode (probs.dist.align_coder, align_bits);
408 end if;
409 end Decode_Distance;
410 --
411 procedure Decode_Length (probs_len : in out Probs_for_LZ_Lengths) is
412 pragma Inline (Decode_Length);
413 choice : Unsigned;
414 begin
415 Decode_Bit (probs_len.choice_1, choice);
416 if choice = 0 then
417 Bit_Tree_Decode (probs_len.low_coder (pos_state), Len_low_bits, len);
418 -- final length is in 2 + [0..7]
419 return;
420 end if;
421 Decode_Bit (probs_len.choice_2, choice);
422 if choice = 0 then
423 Bit_Tree_Decode (probs_len.mid_coder (pos_state), Len_mid_bits, len);
424 len := len + Len_low_symbols;
425 -- final length is in 2 + [8..15]
426 return;
427 end if;
428 Bit_Tree_Decode (probs_len.high_coder, Len_high_bits, len);
429 len := len + Len_low_symbols + Len_mid_symbols;
430 -- final length is in 2 + [16..271]
431 end Decode_Length;
432 --
433 function Is_Distance_Valid return Boolean is
434 pragma Inline (Is_Distance_Valid);
435 begin
436 return
437 rep0 < dict_size
438 and
439 (
440 -- When the window / dictionary is not yet full, the distance
441 -- needs to be between 0 and the position.
442 rep0 <= out_win.pos
443 or
444 -- When the dictionary is full the distance can exceed the
445 -- position (it's a circular buffer).
446 out_win.is_full
447 );
448 end Is_Distance_Valid;
449 --
450 data_length_error : Boolean;
451 dist : UInt32;
452 bit_a, bit_b, bit_c, bit_d, bit_e : Unsigned;
453 --
454 begin -- Process_Distance_and_Length
455 Decode_Bit (probs.switch.rep (state), bit_a);
456 if bit_a = Simple_match_choice then
457 -- "Simple Match"
458 rep3 := rep2;
459 rep2 := rep1;
460 rep1 := rep0;
461 Decode_Length (probs.len);
462 state := Update_State_Match (state);
463 Decode_Distance (dist => rep0);
464 if rep0 = end_of_stream_magic_distance then
465 if Is_Finished_OK then
466 return End_Of_Stream;
467 else
468 raise LZMA_Error with
469 "Range decoder not finished on EOS marker (in Process_Distance_and_Length)";
470 end if;
471 end if;
472 if is_unpack_size_defined and then o.unpackSize = 0 then
473 raise LZMA_Error with
474 "Decoded data will exceed expected data size (in Process_Distance_and_Length, #2).";
475 end if;
476 if not Is_Distance_Valid then
477 raise LZMA_Error with
478 "Invalid distance (in Process_Distance_and_Length):" &
479 "; Dictionary size =" & UInt32'Image (dict_size) &
480 "; Position =" & UInt32'Image (out_win.pos) &
481 "; Distance =" & UInt32'Image (rep0) &
482 "; Is window full ? " & Boolean'Image (out_win.is_full);
483 end if;
484 else
485 -- "Rep Match"
486 if is_unpack_size_defined and then o.unpackSize = 0 then
487 raise LZMA_Error with
488 "Decoded data will exceed expected data size (in Process_Distance_and_Length, #1)";
489 end if;
490 if Is_Empty then
491 raise LZMA_Error with "Output window buffer is empty (in Process_Distance_and_Length)";
492 end if;
493 Decode_Bit (probs.switch.rep_g0 (state), bit_b);
494 if bit_b = The_distance_is_rep0_choice then
495 Decode_Bit (probs.switch.rep0_long (state, pos_state), bit_c);
496 if bit_c = The_length_is_1_choice then
497 state := Update_State_ShortRep (state);
498 Put_Byte (Get_Byte (dist => rep0 + 1));
499 o.unpackSize := o.unpackSize - 1;
500 return Normal; -- GdM: this way, we go to the next iteration (C++: continue)
501 end if;
502 else
503 Decode_Bit (probs.switch.rep_g1 (state), bit_d);
504 if bit_d = The_distance_is_rep1_choice then
505 dist := rep1;
506 else
507 Decode_Bit (probs.switch.rep_g2 (state), bit_e);
508 if bit_e = The_distance_is_rep2_choice then
509 dist := rep2;
510 else
511 dist := rep3;
512 rep3 := rep2;
513 end if;
514 rep2 := rep1;
515 end if;
516 rep1 := rep0;
517 rep0 := dist;
518 end if;
519 Decode_Length (probs.rep_len);
520 state := Update_State_Rep (state);
521 end if;
522 len := len + Min_match_length;
523 data_length_error := False;
524 if is_unpack_size_defined and then o.unpackSize < Data_Bytes_Count (len) then
525 len := Unsigned (o.unpackSize);
526 data_length_error := True;
527 end if;
528 -- The LZ distance/length copy happens here.
529 Copy_Match (dist => rep0 + 1);
530 if data_length_error then
531 raise LZMA_Error with
532 "Decoded data will exceed expected data size (in Process_Distance_and_Length, #3)";
533 end if;
534 o.unpackSize := o.unpackSize - Data_Bytes_Count (len);
535 return Normal;
536 end Process_Distance_and_Length;
537
538 bit_choice : Unsigned;
539 pos_bits_mask : constant UInt32 := 2 ** o.pb - 1;
540 size_defined_and_marker_not_mandatory : constant Boolean :=
541 is_unpack_size_defined and not o.markerIsMandatory;
542
543 procedure Full_Decoding is
544 begin
545 Create (out_win, o.dictionary_size);
546 Init (range_dec);
547 loop
548 if o.unpackSize = 0
549 and then Is_Finished_OK
550 and then size_defined_and_marker_not_mandatory
551 then
552 res := LZMA_finished_without_marker;
553 return;
554 end if;
555 pos_state := Pos_state_range (UInt32 (out_win.total_pos) and pos_bits_mask);
556 Decode_Bit (probs.switch.match (state, pos_state), bit_choice);
557 -- LZ decoding happens here: either we have a new literal
558 -- in 1 byte, or we copy a slice of past data.
559 if bit_choice = Literal_choice then
560 Process_Literal;
561 else
562 case Process_Distance_and_Length is
563 when Normal =>
564 null;
565 when End_Of_Stream =>
566 res := LZMA_finished_with_marker;
567 return;
568 end case;
569 end if;
570 end loop;
571 end Full_Decoding;
572
573 procedure Finalize is
574 procedure Dispose is new Ada.Unchecked_Deallocation (Byte_buffer, p_Byte_buffer);
575 begin
576 Dispose (out_win.buf);
577 o.range_dec_corrupted := range_dec.corrupted;
578 end Finalize;
579
580 begin
581 if some_trace then
582 Ada.Text_IO.Create (LZ77_Dump, Ada.Text_IO.Out_File, "dump.lz77");
583 end if;
584 Full_Decoding;
585 Finalize;
586 if some_trace then
587 Ada.Text_IO.Close (LZ77_Dump);
588 end if;
589 end Decode_Contents;
590
591 procedure Decode_Header (o : out LZMA_Decoder_Info; hints : LZMA_Hints) is
592 header : Byte_buffer (0 .. 12);
593 b : Byte;
594 use type Data_Bytes_Count;
595 last_bit : Natural;
596 begin
597 o.unpackSize := 0;
598 o.unpackSizeDefined := False;
599
600 for i in header'Range loop
601 header (i) := Read_Byte;
602 exit when i = 4 and not hints.has_size;
603 end loop;
604
605 Decode_Properties (o, header);
606
607 if hints.has_size then
608 for i in UInt32'(0) .. 7 loop
609 b := header (5 + i);
610 if b /= 16#FF# then
611 o.unpackSizeDefined := True;
612 end if;
613 end loop;
614 if o.unpackSizeDefined then
615 for i in UInt32'(0) .. 7 loop
616 b := header (5 + i);
617 if b /= 0 then
618 for bit_pos in 0 .. 7 loop
619 if (b and Shift_Left (Byte'(1), bit_pos)) /= 0 then
620 last_bit := bit_pos;
621 end if;
622 end loop;
623 last_bit := last_bit + Natural (8 * i);
624 if last_bit > Data_Bytes_Count'Size - 1 then
625 raise LZMA_Error with
626 "Indicated size bits for decoded data," &
627 Natural'Image (last_bit) &
628 ", exceeds the maximum file size bits," &
629 Natural'Image (Data_Bytes_Count'Size - 1);
630 else
631 o.unpackSize := o.unpackSize + Data_Bytes_Count (b) * 2 ** Natural (8 * i);
632 end if;
633 end if;
634 end loop;
635 o.unpackSize_as_defined := o.unpackSize;
636 else
637 o.unpackSize := Data_Bytes_Count'Last;
638 end if;
639 else
640 o.unpackSize := hints.given_size;
641 o.unpackSizeDefined := True;
642 end if;
643 o.markerIsMandatory := hints.marker_expected or not o.unpackSizeDefined;
644 end Decode_Header;
645
646 procedure Decode (info : out LZMA_Decoder_Info; hints : LZMA_Hints; res : out LZMA_Result) is
647 begin
648 Decode_Header (info, hints);
649 Decode_Contents (info, res);
650 if hints.fail_on_bad_range_code and info.range_dec_corrupted then
651 raise LZMA_Error with "Range decoder had a corrupted value";
652 end if;
653 end Decode;
654
655 procedure Decompress (hints : LZMA_Hints) is
656 -- Technical informations are discarded in this version of Decompress.
657 info : LZMA_Decoder_Info;
658 res : LZMA_Result;
659 begin
660 Decode (info, hints, res);
661 end Decompress;
662
663 function Literal_context_bits (info : LZMA_Decoder_Info) return Natural is
664 begin
665 return info.lc;
666 end Literal_context_bits;
667
668 function Literal_pos_bits (info : LZMA_Decoder_Info) return Natural is
669 begin
670 return info.lp;
671 end Literal_pos_bits;
672
673 function Pos_bits (info : LZMA_Decoder_Info) return Natural is
674 begin
675 return info.pb;
676 end Pos_bits;
677
678 function Unpack_size_defined (info : LZMA_Decoder_Info) return Boolean is
679 begin
680 return info.unpackSizeDefined;
681 end Unpack_size_defined;
682
683 function Unpack_size_as_defined (info : LZMA_Decoder_Info) return Data_Bytes_Count is
684 begin
685 return info.unpackSize_as_defined;
686 end Unpack_size_as_defined;
687
688 function Probability_model_size (info : LZMA_Decoder_Info) return Interfaces.Unsigned_32 is
689 probs : All_probabilities (last_lit_prob_index => 16#300# * 2 ** (info.lc + info.lp) - 1);
690 begin
691 return probs'Size / 8;
692 end Probability_model_size;
693
694 function Dictionary_size (info : LZMA_Decoder_Info) return Interfaces.Unsigned_32 is
695 begin
696 return info.dictionary_size;
697 end Dictionary_size;
698
699 function Dictionary_size_in_properties (info : LZMA_Decoder_Info) return Interfaces.Unsigned_32 is
700 begin
701 return info.dictSizeInProperties;
702 end Dictionary_size_in_properties;
703
704 function Range_decoder_corrupted (info : LZMA_Decoder_Info) return Boolean is
705 begin
706 return info.range_dec_corrupted;
707 end Range_decoder_corrupted;
708
709 end LZMA.Decoding;
Web view of Ada source code generated by GNATHTML, project: ALI_Parse version 1.0.
Zip-Ada: Ada library for zip archive files (.zip).
Ada programming.
Some news about Zip-Ada and other Ada projects
on Gautier's blog.
