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 .. 2018 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 38with Ada.Unchecked_Deallocation; 39with Ada.Exceptions; use Ada.Exceptions; 40 41package 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_Exception(LZMA_Error'Identity, "Incorrect LZMA properties"); 86 -- raise LZMA_Error with "Incorrect LZMA properties"; -- Ada 2005+ 87 end if; 88 o.lc := Literal_context_bits_range(d mod 9); 89 d := d / 9; 90 o.lp := Literal_position_bits_range(d mod 5); 91 o.pb := Position_bits_range(d / 5); 92 o.dictSizeInProperties := 0; 93 for i in 0..3 loop 94 o.dictSizeInProperties := o.dictSizeInProperties + 95 UInt32(b(UInt32(i) + 1 + b'First)) * 2 ** (8 * i); 96 end loop; 97 o.dictionary_size := o.dictSizeInProperties; 98 if o.dictionary_size < Min_dictionary_size then 99 o.dictionary_size := Min_dictionary_size; 100 end if; 101 end Decode_Properties; 102 103 procedure Decode_Contents(o: in out LZMA_Decoder_Info; res: out LZMA_Result) is 104 state : State_range := 0; 105 -- Small stack of recent distances used for LZ. Required: initialized with zero values. 106 rep0, rep1, rep2, rep3 : UInt32 := 0; 107 pos_state: Pos_state_range; 108 -- Local copies of invariant properties. 109 unpack_size_def: constant Boolean:= o.unpackSizeDefined; 110 literal_pos_mask: constant UInt32:= 2 ** o.lp - 1; 111 lc: constant Literal_context_bits_range:= o.lc; 112 -- 113 use type Data_Bytes_Count; 114 out_win : Out_Window; 115 -- Local range decoder 116 range_dec: Range_Decoder; 117 -- Entire probability model. Max lit prob index: 3,145,727. 118 probs: All_probabilities(last_lit_prob_index => 16#300# * 2 ** (o.lc + o.lp) - 1); 119 120 -- Normalize corresponds to G.N.N. Martin's revised algorithm's adding of 121 -- trailing digits - for encoding. Here we decode and know the encoded 122 -- data, brought by Read_Byte. 123 procedure Normalize is 124 pragma Inline(Normalize); 125 begin 126 -- Assertion: the width is large enough for the normalization to be needed 127 -- once per bit decoding. Worst case: width = 2**24 before; bound = (2**13) * (2**5-1) 128 -- new width's (leading binary digit) = 2**17; after normalization: 2**(17+8) = 2**25. 129 if range_dec.width < width_threshold then 130 range_dec.width := Shift_Left(range_dec.width, 8); 131 range_dec.code := Shift_Left(range_dec.code, 8) or UInt32(Read_Byte); 132 end if; 133 end Normalize; 134 135 procedure Decode_Bit(prob: in out CProb; symbol: out Unsigned) is 136 pragma Inline(Decode_Bit); 137 cur_prob: constant CProb:= prob; -- Local copy 138 bound: constant UInt32:= Shift_Right(range_dec.width, Probability_model_bits) * UInt32(cur_prob); 139 -- See encoder for explanations about the maths. 140 begin 141 if range_dec.code < bound then 142 prob:= cur_prob + Shift_Right(Probability_model_count - cur_prob, Probability_change_bits); 143 range_dec.width := bound; 144 Normalize; 145 symbol := 0; 146 else 147 prob:= cur_prob - Shift_Right(cur_prob, Probability_change_bits); 148 range_dec.code := range_dec.code - bound; 149 range_dec.width := range_dec.width - bound; 150 Normalize; 151 symbol := 1; 152 end if; 153 end Decode_Bit; 154 155 function Is_Empty return Boolean is 156 pragma Inline(Is_Empty); 157 begin 158 return out_win.pos = 0 and then not out_win.is_full; 159 end Is_Empty; 160 161 procedure Put_Byte(b: Byte) is 162 pragma Inline(Put_Byte); 163 begin 164 out_win.total_pos := out_win.total_pos + 1; 165 out_win.buf(out_win.pos):= b; 166 out_win.pos := out_win.pos + 1; 167 if out_win.pos = out_win.size then 168 out_win.pos := 0; 169 out_win.is_full := True; 170 end if; 171 Write_Byte(b); 172 end Put_Byte; 173 174 function Get_Byte(dist: UInt32) return Byte is 175 pragma Inline(Get_Byte); 176 begin 177 if dist <= out_win.pos then 178 return out_win.buf(out_win.pos - dist); 179 else 180 return out_win.buf(out_win.pos - dist + out_win.size); 181 end if; 182 end Get_Byte; 183 184 procedure Process_Literal is 185 pragma Inline(Process_Literal); 186 prev_byte : Byte:= 0; 187 symbol : Unsigned:= 1; 188 lit_state : Integer; 189 probs_idx : Integer; 190 bit_nomatch : Unsigned; 191 begin 192 if o.unpackSize = 0 and then unpack_size_def then 193 Raise_Exception( 194 LZMA_Error'Identity, 195 "Decoded data will exceed expected data size (Process_Literal)" 196 ); 197 end if; 198 -- 199 if not Is_Empty then 200 prev_byte := Get_Byte(dist => 1); 201 end if; 202 lit_state := 203 Integer( 204 Shift_Left(UInt32(out_win.total_pos) and literal_pos_mask, lc) + 205 Shift_Right(UInt32(prev_byte), 8 - lc) 206 ); 207 probs_idx:= 16#300# * lit_state; 208 if state < 7 then 209 loop 210 Decode_Bit(probs.lit(probs_idx + Integer(symbol)), bit_nomatch); 211 symbol := (symbol + symbol) or bit_nomatch; 212 exit when symbol >= 16#100#; 213 end loop; 214 else 215 declare 216 -- 217 -- The probabilities used for decoding this literal assume 218 -- that the current literal sequence resembles to the last 219 -- distance-length copied sequence. 220 -- 221 match_byte : UInt32 := UInt32(Get_Byte(dist => rep0 + 1)); 222 match_bit : UInt32; -- either 0 or 16#100# 223 prob_idx_match : Integer; -- either 0 (normal case without match), 16#100# or 16#200# 224 bit_a, bit_b : Unsigned; 225 begin 226 loop 227 match_byte := match_byte + match_byte; 228 match_bit := match_byte and 16#100#; 229 prob_idx_match:= Integer(16#100# + match_bit); 230 Decode_Bit(probs.lit(probs_idx + prob_idx_match + Integer(symbol)), bit_a); 231 symbol := (symbol + symbol) or bit_a; 232 exit when symbol >= 16#100#; 233 if match_bit /= Shift_Left(UInt32(bit_a), 8) then 234 -- No bit match, then give up byte match 235 loop 236 Decode_Bit(probs.lit(probs_idx + Integer(symbol)), bit_b); 237 symbol := (symbol + symbol) or bit_b; 238 exit when symbol >= 16#100#; 239 end loop; 240 exit; 241 end if; 242 end loop; 243 end; 244 end if; 245 Put_Byte(Byte(symbol - 16#100#)); -- The output of a simple literal happens here. 246 -- 247 state := Update_State_Literal(state); 248 o.unpackSize:= o.unpackSize - 1; 249 end Process_Literal; 250 251 dict_size : constant UInt32:= o.dictionary_size; 252 253 function Is_Finished_OK return Boolean is 254 pragma Inline(Is_Finished_OK); 255 begin 256 return range_dec.code = 0; 257 end Is_Finished_OK; 258 259 type DL_Return_Code is (Normal, End_Of_Stream); 260 261 function Process_Distance_and_Length return DL_Return_Code is 262 pragma Inline(Process_Distance_and_Length); 263 -- 264 procedure Bit_Tree_Decode( 265 prob : in out CProb_array; 266 num_bits : Positive; 267 m : out Unsigned) 268 is 269 pragma Inline(Bit_Tree_Decode); 270 a_bit: Unsigned; 271 begin 272 m:= 1; 273 for count in reverse 1 .. num_bits loop 274 Decode_Bit(prob(Integer(m) + prob'First), a_bit); 275 m:= m + m + a_bit; 276 end loop; 277 m:= m - 2**num_bits; 278 end Bit_Tree_Decode; 279 -- 280 len: Unsigned:= 0; 281 -- 282 procedure Copy_Match(dist: UInt32) is 283 pragma Inline(Copy_Match); 284 len32: constant UInt32:= UInt32(len); 285 -- Conversion to UInt64 needed for dictionary size > 2**32 - 273: 286 will_fill: constant Boolean:= 287 UInt64 (out_win.pos) + UInt64 (len32) >= UInt64 (out_win.size); 288 -- 289 procedure Easy_case is 290 pragma Inline(Easy_case); 291 src_from, src_to: UInt32; 292 b1: Byte; 293 begin 294 -- The src and dest slices are within circular buffer bounds. 295 -- May overlap (len32 > dist), even several times. 296 src_from := out_win.pos - dist; 297 src_to := out_win.pos - dist + len32 - 1; 298 -- We copy in forward order, with eventual overlapping(s).. 299 for i in src_from .. src_to loop 300 b1:= out_win.buf(i); 301 out_win.buf(i + dist):= b1; 302 Write_Byte(b1); 303 end loop; 304 out_win.pos := out_win.pos + len32; 305 end Easy_case; 306 -- 307 procedure Modulo_case is 308 pragma Inline(Modulo_case); 309 b2, b3: Byte; 310 begin 311 -- src starts below 0 or dest goes beyond size-1 312 for count in reverse 1..len loop 313 if dist <= out_win.pos then 314 b2:= out_win.buf(out_win.pos - dist); 315 out_win.buf(out_win.pos):= b2; 316 out_win.pos := out_win.pos + 1; 317 if out_win.pos = out_win.size then 318 out_win.pos := 0; 319 end if; 320 Write_Byte(b2); 321 else 322 b3:= out_win.buf(out_win.size - dist + out_win.pos); 323 out_win.buf(out_win.pos):= b3; 324 out_win.pos := out_win.pos + 1; 325 if out_win.pos = out_win.size then 326 out_win.pos := 0; 327 end if; 328 Write_Byte(b3); 329 end if; 330 end loop; 331 end Modulo_case; 332 begin 333 out_win.is_full := will_fill or else out_win.is_full; 334 out_win.total_pos := out_win.total_pos + len; 335 if dist <= out_win.pos and not will_fill then 336 Easy_case; 337 else 338 Modulo_case; 339 end if; 340 end Copy_Match; 341 -- 342 procedure Decode_Distance(dist: out UInt32) is 343 pragma Inline(Decode_Distance); 344 -- 345 decode_direct: UInt32; 346 -- 347 procedure Decode_Direct_Bits(num_bits : Natural) is 348 pragma Inline(Decode_Direct_Bits); 349 t: UInt32; 350 begin 351 decode_direct := 0; 352 for count in reverse 1..num_bits loop 353 range_dec.width := Shift_Right(range_dec.width, 1); 354 range_dec.code := range_dec.code - range_dec.width; 355 t := - Shift_Right(range_dec.code, 31); 356 range_dec.code := range_dec.code + (range_dec.width and t); 357 if range_dec.code = range_dec.width then 358 range_dec.corrupted := True; 359 end if; 360 Normalize; 361 decode_direct := decode_direct + decode_direct + t + 1; 362 end loop; 363 end Decode_Direct_Bits; 364 -- 365 procedure Bit_Tree_Reverse_Decode(prob: in out CProb_array; num_bits: in Natural) is 366 pragma Inline(Bit_Tree_Reverse_Decode); 367 m: Unsigned := 1; 368 a_bit: Unsigned; 369 begin 370 for i in 0 .. num_bits-1 loop 371 Decode_Bit(prob(Integer(m) + prob'First), a_bit); 372 m := m + m + a_bit; 373 dist := dist or Shift_Left(UInt32(a_bit), i); 374 end loop; 375 end Bit_Tree_Reverse_Decode; 376 -- 377 -- len has been set up previously by Decode_Length. 378 len_state : constant Unsigned := Unsigned'Min(len, Len_to_pos_states - 1); 379 dist_slot : Unsigned; 380 numDirectBits : Natural; 381 -- 382 begin -- Decode_Distance 383 Bit_Tree_Decode(probs.dist.slot_coder(len_state), Dist_slot_bits, dist_slot); 384 if dist_slot < Start_dist_model_index then 385 dist:= UInt32(dist_slot); 386 return; 387 end if; 388 numDirectBits := Natural(Shift_Right(UInt32(dist_slot), 1) - 1); 389 dist := Shift_Left(2 or (UInt32(dist_slot) and 1), numDirectBits); 390 if dist_slot < End_dist_model_index then 391 Bit_Tree_Reverse_Decode( 392 probs.dist.pos_coder(Integer(dist) - Integer(dist_slot) .. Pos_coder_range'Last), 393 numDirectBits 394 ); 395 else 396 Decode_Direct_Bits(numDirectBits - Align_bits); 397 dist:= dist + Shift_Left(decode_direct, Align_bits); 398 Bit_Tree_Reverse_Decode(probs.dist.align_coder, Align_bits); 399 end if; 400 end Decode_Distance; 401 -- 402 procedure Decode_Length(probs_len: in out Probs_for_LZ_Lengths) is 403 pragma Inline(Decode_Length); 404 choice: Unsigned; 405 begin 406 Decode_Bit(probs_len.choice_1, choice); 407 if choice = 0 then 408 Bit_Tree_Decode(probs_len.low_coder(pos_state), Len_low_bits, len); 409 -- final length is in 2 + [0..7] 410 return; 411 end if; 412 Decode_Bit(probs_len.choice_2, choice); 413 if choice = 0 then 414 Bit_Tree_Decode(probs_len.mid_coder(pos_state), Len_mid_bits, len); 415 len:= len + Len_low_symbols; 416 -- final length is in 2 + [8..15] 417 return; 418 end if; 419 Bit_Tree_Decode(probs_len.high_coder, Len_high_bits, len); 420 len:= len + Len_low_symbols + Len_mid_symbols; 421 -- final length is in 2 + [16..271] 422 end Decode_Length; 423 -- 424 function Check_Distance return Boolean is 425 pragma Inline(Check_Distance); 426 begin 427 return rep0 <= out_win.pos or out_win.is_full; 428 end Check_Distance; 429 -- 430 isError: Boolean; 431 dist: UInt32; 432 bit_a, bit_b, bit_c, bit_d, bit_e: Unsigned; 433 -- 434 begin -- Process_Distance_and_Length 435 Decode_Bit(probs.switch.rep(state), bit_a); 436 if bit_a = Simple_match_choice then 437 -- "Simple Match" 438 rep3 := rep2; 439 rep2 := rep1; 440 rep1 := rep0; 441 Decode_Length(probs.len); 442 state := Update_State_Match(state); 443 Decode_Distance(dist => rep0); 444 if rep0 = end_of_stream_magic_distance then 445 if Is_Finished_OK then 446 return End_Of_Stream; 447 else 448 Raise_Exception( 449 LZMA_Error'Identity, 450 "Range decoder not finished on EOS marker (in Process_Distance_and_Length)" 451 ); 452 end if; 453 end if; 454 if (o.unpackSize = 0 and then unpack_size_def) or 455 rep0 >= dict_size or not Check_Distance 456 then 457 Raise_Exception( 458 LZMA_Error'Identity, 459 "Decoded data will exceed expected data size (in Process_Distance_and_Length, #2)." & 460 "; Distance =" & UInt32'Image(rep0) & 461 "; Dictionary size =" & UInt32'Image(dict_size) & 462 "; Position =" & UInt32'Image(out_win.pos) & 463 "; Is window full ? " & Boolean'Image(out_win.is_full) 464 ); 465 end if; 466 else 467 -- "Rep Match" 468 if o.unpackSize = 0 and then unpack_size_def then 469 Raise_Exception( 470 LZMA_Error'Identity, 471 "Decoded data will exceed expected data size (in Process_Distance_and_Length, #1)" 472 ); 473 end if; 474 if Is_Empty then 475 Raise_Exception( 476 LZMA_Error'Identity, 477 "Output window buffer is empty (in Process_Distance_and_Length)" 478 ); 479 end if; 480 Decode_Bit(probs.switch.rep_g0(state), bit_b); 481 if bit_b = The_distance_is_rep0_choice then 482 Decode_Bit(probs.switch.rep0_long(state, pos_state), bit_c); 483 if bit_c = The_length_is_1_choice then 484 state := Update_State_ShortRep(state); 485 Put_Byte(Get_Byte(dist => rep0 + 1)); 486 o.unpackSize:= o.unpackSize - 1; 487 return Normal; -- GdM: this way, we go to the next iteration (C++: continue) 488 end if; 489 else 490 Decode_Bit(probs.switch.rep_g1(state), bit_d); 491 if bit_d = The_distance_is_rep1_choice then 492 dist := rep1; 493 else 494 Decode_Bit(probs.switch.rep_g2(state), bit_e); 495 if bit_e = The_distance_is_rep2_choice then 496 dist := rep2; 497 else 498 dist := rep3; 499 rep3 := rep2; 500 end if; 501 rep2 := rep1; 502 end if; 503 rep1 := rep0; 504 rep0 := dist; 505 end if; 506 Decode_Length(probs.rep_len); 507 state := Update_State_Rep(state); 508 end if; 509 len := len + Min_match_length; 510 isError := False; 511 if o.unpackSize < Data_Bytes_Count(len) and then unpack_size_def then 512 len := Unsigned(o.unpackSize); 513 isError := True; 514 end if; 515 -- The LZ distance/length copy happens here. 516 Copy_Match(dist => rep0 + 1); 517 o.unpackSize:= o.unpackSize - Data_Bytes_Count(len); 518 if isError then 519 Raise_Exception( 520 LZMA_Error'Identity, 521 "Decoded data will exceed expected data size (in Process_Distance_and_Length, #3)" 522 ); 523 end if; 524 return Normal; 525 end Process_Distance_and_Length; 526 527 bit_choice: Unsigned; 528 pos_bits_mask : constant UInt32 := 2 ** o.pb - 1; 529 size_defined_and_marker_not_mandatory: constant Boolean:= 530 unpack_size_def and not o.markerIsMandatory; 531 532 procedure Finalize is 533 procedure Dispose is new Ada.Unchecked_Deallocation(Byte_buffer, p_Byte_buffer); 534 begin 535 Dispose(out_win.buf); 536 o.range_dec_corrupted:= range_dec.corrupted; 537 end Finalize; 538 539 begin 540 Create(out_win, o.dictionary_size); 541 Init(range_dec); 542 loop 543 if o.unpackSize = 0 544 and then Is_Finished_OK 545 and then size_defined_and_marker_not_mandatory 546 then 547 res:= LZMA_finished_without_marker; 548 Finalize; 549 return; 550 end if; 551 pos_state := Pos_state_range(UInt32(out_win.total_pos) and pos_bits_mask); 552 Decode_Bit(probs.switch.match(state, pos_state), bit_choice); 553 -- LZ decoding happens here: either we have a new literal 554 -- in 1 byte, or we copy a slice of past data. 555 if bit_choice = Literal_choice then 556 Process_Literal; 557 else 558 case Process_Distance_and_Length is 559 when Normal => 560 null; 561 when End_Of_Stream => 562 res:= LZMA_finished_with_marker; 563 Finalize; 564 return; 565 end case; 566 end if; 567 end loop; 568 end Decode_Contents; 569 570 procedure Decode_Header(o: out LZMA_Decoder_Info; hints: LZMA_Hints) is 571 header: Byte_buffer(0..12); 572 b: Byte; 573 use type Data_Bytes_Count; 574 last_bit: Natural; 575 begin 576 o.unpackSize := 0; 577 o.unpackSizeDefined := False; 578 579 for i in header'Range loop 580 header(i):= Read_Byte; 581 exit when i = 4 and not hints.has_size; 582 end loop; 583 584 Decode_Properties(o, header); 585 586 if hints.has_size then 587 for i in UInt32'(0)..7 loop 588 b:= header(5 + i); 589 if b /= 16#FF# then 590 o.unpackSizeDefined := True; 591 end if; 592 end loop; 593 if o.unpackSizeDefined then 594 for i in UInt32'(0)..7 loop 595 b:= header(5 + i); 596 if b /= 0 then 597 for bit_pos in 0 .. 7 loop 598 if (b and Shift_Left(Byte'(1), bit_pos)) /= 0 then 599 last_bit:= bit_pos; 600 end if; 601 end loop; 602 last_bit:= last_bit + Natural(8 * i); 603 if last_bit > Data_Bytes_Count'Size - 1 then 604 Raise_Exception( 605 LZMA_Error'Identity, 606 "Indicated size bits for decoded data," & 607 Natural'Image(last_bit) & 608 ", exceeds the maximum file size bits," & 609 Natural'Image(Data_Bytes_Count'Size - 1) 610 ); 611 else 612 o.unpackSize := o.unpackSize + Data_Bytes_Count(b) * 2 ** Natural(8 * i); 613 end if; 614 end if; 615 end loop; 616 o.unpackSize_as_defined:= o.unpackSize; 617 else 618 o.unpackSize:= Data_Bytes_Count'Last; 619 end if; 620 else 621 o.unpackSize:= hints.given_size; 622 o.unpackSizeDefined:= True; 623 end if; 624 o.markerIsMandatory := hints.marker_expected or not o.unpackSizeDefined; 625 end Decode_Header; 626 627 procedure Decode(info: out LZMA_Decoder_Info; hints: LZMA_Hints; res: out LZMA_Result) is 628 begin 629 Decode_Header (info, hints); 630 Decode_Contents (info, res); 631 if hints.fail_on_bad_range_code and info.range_dec_corrupted then 632 Raise_Exception (LZMA_Error'Identity, "Range decoder had a corrupted value (code = range)"); 633 end if; 634 end Decode; 635 636 procedure Decompress(hints: LZMA_Hints) is 637 -- Technical informations are discarded in this version of Decompress. 638 info : LZMA_Decoder_Info; 639 res : LZMA_Result; 640 begin 641 Decode (info, hints, res); 642 end Decompress; 643 644 function Literal_context_bits(info: LZMA_Decoder_Info) return Natural is 645 begin 646 return info.lc; 647 end Literal_context_bits; 648 649 function Literal_pos_bits(info: LZMA_Decoder_Info) return Natural is 650 begin 651 return info.lp; 652 end Literal_pos_bits; 653 654 function Pos_bits(info: LZMA_Decoder_Info) return Natural is 655 begin 656 return info.pb; 657 end Pos_bits; 658 659 function Unpack_size_defined(info: LZMA_Decoder_Info) return Boolean is 660 begin 661 return info.unpackSizeDefined; 662 end Unpack_size_defined; 663 664 function Unpack_size_as_defined(info: LZMA_Decoder_Info) return Data_Bytes_Count is 665 begin 666 return info.unpackSize_as_defined; 667 end Unpack_size_as_defined; 668 669 function Probability_model_size(info: LZMA_Decoder_Info) return Interfaces.Unsigned_32 is 670 probs: All_probabilities(last_lit_prob_index => 16#300# * 2 ** (info.lc + info.lp) - 1); 671 begin 672 return probs'Size / 8; 673 end Probability_model_size; 674 675 function Dictionary_size(info: LZMA_Decoder_Info) return Interfaces.Unsigned_32 is 676 begin 677 return info.dictionary_size; 678 end Dictionary_size; 679 680 function Dictionary_size_in_properties(info: LZMA_Decoder_Info) return Interfaces.Unsigned_32 is 681 begin 682 return info.dictSizeInProperties; 683 end Dictionary_size_in_properties; 684 685 function Range_decoder_corrupted(info: LZMA_Decoder_Info) return Boolean is 686 begin 687 return info.range_dec_corrupted; 688 end Range_decoder_corrupted; 689 690end LZMA.Decoding; 691