— See bzip2.ads for legal stuff
—
— Documentation pointers:
—
— Burrows – Wheeler transform
— http://en.wikipedia.org/wiki/Burrows%E2%80%93Wheeler_transform
— MTF Move – To – Front
— http://fr.wikipedia.org/wiki/Move – To – Front
—
— Translated on 20 – Oct – 2009 by (New) P2Ada v. 15 – Nov – 2006
—
— with Ada.Text_IO; use Ada.Text_IO;
with Ada.Unchecked_Deallocation;
package body BZip2 is
procedure Decompress is
max_groups : constant := 6;
max_alpha_size : constant := 258;
max_code_len : constant := 23;
group_size : constant := 50;
max_selectors : constant := 2 + (900_000 / group_size);
sub_block_size : constant := 100_000;
type Length_array is array (Integer range <>) of Natural;
block_randomized : Boolean := False;
block_size : Natural;
use Interfaces;
type Tcardinal_array is array (Integer range <>) of Unsigned_32;
type Pcardinal_array is access Tcardinal_array;
procedure Dispose is new Ada.Unchecked_Deallocation (Tcardinal_array, Pcardinal_array);
tt : Pcardinal_array;
tt_count : Natural;
rle_run_left : Natural := 0;
rle_run_data : Unsigned_8 := 0;
decode_available : Natural := Natural’Last;
block_origin : Natural := 0;
read_data : Unsigned_8 := 0;
bits_available : Natural := 0;
inuse_count : Natural;
seq_to_unseq : array (0 .. 255) of Natural;
global_alpha_size : Natural;
group_count : Natural;
—
selector_count : Natural;
selector, selector_mtf : array (0 .. max_selectors) of Unsigned_8;
—
type Alpha_U32_array is array (0 .. max_alpha_size) of Unsigned_32;
type Alpha_Nat_array is array (0 .. max_alpha_size) of Natural;
len : array (0 .. max_groups) of Alpha_Nat_array;
global_limit,
global_base,
global_perm : array (0 .. max_groups) of Alpha_U32_array;
—
minlens : Length_array (0 .. max_groups);
cftab : array (0 .. 257) of Natural;
—
end_reached : Boolean := False;
in_buf : Buffer (1 .. input_buffer_size);
in_idx : Natural := in_buf’Last + 1;
function Read_byte return Unsigned_8 is
res : Unsigned_8;
begin
if in_idx > in_buf’Last then
Read (in_buf);
in_idx := in_buf’First;
end if;
res := in_buf (in_idx);
in_idx := in_idx + 1;
return res;
end Read_byte;
procedure hb_create_decode_tables (limit, base, perm : in out Alpha_U32_array;
length : Alpha_Nat_array;
min_len, max_len : Natural;
alpha_size : Integer) is
pp, idx : Integer;
vec : Unsigned_32;
begin
pp := 0;
for i in min_len .. max_len loop
for j in 0 .. alpha_size – 1 loop
if length (j) = i then
perm (pp) := Unsigned_32 (j);
pp := pp + 1;
end if;
end loop;
end loop;
for i in 0 .. max_code_len – 1 loop
base (i) := 0;
limit (i) := 0;
end loop;
for i in 0 .. alpha_size – 1 loop
idx := length (i) + 1;
base (idx) := base (idx) + 1;
end loop;
for i in 1 .. max_code_len – 1 loop
base (i) := base (i) + base (i – 1);
end loop;
vec := 0;
for i in min_len .. max_len loop
vec := vec + base (i + 1) – base (i);
limit (i) := vec – 1;
vec := vec * 2;
end loop;
for i in min_len + 1 .. max_len loop
base (i) := (limit (i – 1) + 1) * 2 – base (i);
end loop;
end hb_create_decode_tables;
procedure Init is
magic : String (1 .. 3);
b : Unsigned_8;
begin
— Read the magic.
for i in magic’Range loop
b := Read_byte;
magic (i) := Character’Val (b);
end loop;
if magic /= “BZh” then
raise bad_header_magic;
end if;
— Read the block size and allocate the working array.
b := Read_byte;
block_size := Natural (b) – Character’Pos (‘0’);
tt := new Tcardinal_array (0 .. block_size * sub_block_size);
end Init;
function get_bits (n : Natural) return Unsigned_8 is
Result_get_bits : Unsigned_8;
data : Unsigned_8;
begin
if n > bits_available then
data := Read_byte;
Result_get_bits := Shift_Right (read_data, 8 – n) or Shift_Right (data, 8 – (n – bits_available));
read_data := Shift_Left (data, n – bits_available);
bits_available := bits_available + 8;
else
Result_get_bits := Shift_Right (read_data, 8 – n);
read_data := Shift_Left (read_data, n);
end if;
bits_available := bits_available – n;
return Result_get_bits;
end get_bits;
function get_bits_32 (n : Natural) return Unsigned_32 is
begin
return Unsigned_32 (get_bits (n));
end get_bits_32;
function get_boolean return Boolean is
begin
return Boolean’Val (get_bits (1));
end get_boolean;
function get_byte return Unsigned_8 is
begin
return get_bits (8);
end get_byte;
function get_cardinal24 return Unsigned_32 is
begin
return Shift_Left (get_bits_32 (8), 16) or Shift_Left (get_bits_32 (8), 8) or get_bits_32 (8);
end get_cardinal24;
function get_cardinal return Unsigned_32 is
begin
return Shift_Left (get_bits_32 (8), 24) or
Shift_Left (get_bits_32 (8), 16) or
Shift_Left (get_bits_32 (8), 8) or
get_bits_32 (8);
end get_cardinal;
— Receive the mapping table. To save space, the inuse set is stored in pieces
— of 16 bits. First 16 bits are stored which pieces of 16 bits are used, then
— the pieces follow.
procedure receive_mapping_table is
inuse16 : array (0 .. 15) of Boolean;
–* inuse : array (0 .. 255) of Boolean; — for dump purposes
begin
inuse16 := (others => False);
— Receive the first 16 bits which tell which pieces are stored.
for i in 0 .. 15 loop
inuse16 (i) := get_boolean;
end loop;
— Receive the used pieces.
–* inuse := (others => False);
inuse_count := 0;
for i in 0 .. 15 loop
if inuse16 (i) then
for j in 0 .. 15 loop
if get_boolean then
–* inuse (16*i + j) := True;
seq_to_unseq (inuse_count) := 16 * i + j;
inuse_count := inuse_count + 1;
end if;
end loop;
end if;
end loop;
end receive_mapping_table;
— Receives the selectors.
procedure receive_selectors is
j : Unsigned_8;
begin
group_count := Natural (get_bits (3));
selector_count := Natural (Shift_Left (get_bits_32 (8), 7) or get_bits_32 (7));
for i in 0 .. selector_count – 1 loop
j := 0;
while get_boolean loop
j := j + 1;
if j > 5 then
raise data_error;
end if;
end loop;
selector_mtf (i) := j;
end loop;
end receive_selectors;
— Undo the MTF values for the selectors.
procedure undo_mtf_values is
pos : array (0 .. max_groups) of Natural;
v, tmp : Natural;
begin
for w in 0 .. group_count – 1 loop
pos (w) := w;
end loop;
for i in 0 .. selector_count – 1 loop
v := Natural (selector_mtf (i));
tmp := pos (v);
while v /= 0 loop
pos (v) := pos (v – 1);
v := v – 1;
end loop;
pos (0) := tmp;
selector (i) := Unsigned_8 (tmp);
end loop;
end undo_mtf_values;
procedure receive_coding_tables is
curr : Natural;
begin
for t in 0 .. group_count – 1 loop
curr := Natural (get_bits (5));
for i in 0 .. global_alpha_size – 1 loop
loop
if curr not in 1 .. 20 then
raise data_error;
end if;
exit when not get_boolean;
if get_boolean then
curr := curr – 1;
else
curr := curr + 1;
end if;
end loop;
len (t) (i) := curr;
end loop;
end loop;
end receive_coding_tables;
— Builds the Huffman tables.
procedure make_hufftab is
minlen, maxlen : Natural;
begin
for t in 0 .. group_count – 1 loop
minlen := 32;
maxlen := 0;
for i in 0 .. global_alpha_size – 1 loop
if len (t) (i) > maxlen then
maxlen := len (t) (i);
end if;
if len (t) (i) < minlen then
minlen := len (t) (i);
end if;
end loop;
hb_create_decode_tables (global_limit (t), global_base (t), global_perm (t), len (t),
minlen, maxlen, global_alpha_size);
minlens (t) := minlen;
end loop;
end make_hufftab;
-------------------------
-- MTF - Move To Front --
-------------------------
procedure receive_mtf_values is
--
mtfa_size : constant := 4096;
mtfl_size : constant := 16;
mtfbase : array (0 .. 256 / mtfl_size - 1) of Natural;
mtfa : array (0 .. mtfa_size - 1) of Natural;
--
procedure init_mtf is
k : Natural := mtfa_size - 1;
begin
for i in reverse 0 .. 256 / mtfl_size - 1 loop
for j in reverse 0 .. mtfl_size - 1 loop
mtfa (k) := i * mtfl_size + j;
k := k - 1;
end loop;
mtfbase (i) := k + 1;
end loop;
end init_mtf;
--
group_pos, group_no : Integer;
gminlen, gsel : Natural;
--
function get_mtf_value return Unsigned_32 is
zn : Natural;
zvec : Unsigned_32;
begin
if group_pos = 0 then
group_no := group_no + 1;
group_pos := group_size;
gsel := Natural (selector (group_no));
gminlen := minlens (gsel);
end if;
group_pos := group_pos - 1;
zn := gminlen;
zvec := get_bits_32 (zn);
while zvec > global_limit (gsel) (zn) loop
zn := zn + 1;
zvec := Shift_Left (zvec, 1) or get_bits_32 (1);
end loop;
return global_perm (gsel) (Natural (zvec – global_base (gsel) (zn)));
end get_mtf_value;
—
procedure move_mtf_block is
j, k : Natural;
begin
k := mtfa_size;
for i in reverse 0 .. 256 / mtfl_size – 1 loop
j := mtfbase (i);
mtfa (k – 16 .. k – 1) := mtfa (j .. j + 15);
k := k – 16;
mtfbase (i) := k;
end loop;
end move_mtf_block;
—
run_b : constant := 1;
t : Natural;
next_sym : Unsigned_32;
es : Natural;
n, nn : Natural;
p, q : Natural; — indexes mtfa
u, v : Natural; — indexes mtfbase
lno, off : Natural;
begin — receive_mtf_values
group_no := -1;
group_pos := 0;
t := 0;
cftab := (others => 0);
init_mtf;
next_sym := get_mtf_value;
—
while Natural (next_sym) /= inuse_count + 1 loop
if next_sym <= run_b then
es := 0;
n := 0;
loop
es := es + Natural (Shift_Left (next_sym + 1, n));
n := n + 1;
next_sym := get_mtf_value;
exit when next_sym > run_b;
end loop;
n := seq_to_unseq (mtfa (mtfbase (0)));
cftab (n) := cftab (n) + es;
if t + es > sub_block_size * block_size then
raise data_error;
end if;
while es > 0 loop
tt.all (t) := Unsigned_32 (n);
es := es – 1;
t := t + 1;
end loop;
else
nn := Natural (next_sym – 1);
if nn < mtfl_size then
-- Avoid the costs of the general case.
p := mtfbase (0);
q := p + nn;
n := mtfa (q);
loop
mtfa (q) := mtfa (q - 1);
q := q - 1;
exit when q = p;
end loop;
mtfa (q) := n;
else
-- General case.
lno := nn / mtfl_size;
off := nn mod mtfl_size;
p := mtfbase (lno);
q := p + off;
n := mtfa (q);
while q /= p loop
mtfa (q) := mtfa (q - 1);
q := q - 1;
end loop;
u := mtfbase'First;
v := u + lno;
loop
mtfa (mtfbase (v)) := mtfa (mtfbase (v - 1) + mtfl_size - 1);
v := v - 1;
mtfbase (v) := mtfbase (v) - 1;
exit when v = u;
end loop;
mtfa (mtfbase (v)) := n;
if mtfbase (v) = 0 then
move_mtf_block;
end if;
end if;
cftab (seq_to_unseq (n)) := cftab (seq_to_unseq (n)) + 1;
tt.all (t) := Unsigned_32 (seq_to_unseq (n));
t := t + 1;
if t > sub_block_size * block_size then
raise data_error;
end if;
next_sym := get_mtf_value;
end if;
end loop;
tt_count := t;
— Setup cftab to facilitate generation of T^ ( – 1).
t := 0;
for i in 0 .. 256 loop
nn := cftab (i);
cftab (i) := t;
t := t + nn;
end loop;
end receive_mtf_values;
procedure detransform is
a : Unsigned_32;
p, q, r, i255 : Natural;
begin
a := 0;
p := tt’First;
q := p + tt_count;
while p /= q loop
i255 := Natural (tt.all (p) and 16#ff#);
r := cftab (i255);
cftab (i255) := cftab (i255) + 1;
tt.all (r) := tt.all (r) or a;
a := a + 256;
p := p + 1;
end loop;
end detransform;
— Cyclic redundancy check to verify uncompressed block data integrity
package CRC is
procedure Init (CRC_Value : out Unsigned_32);
function Final (CRC_Value : Unsigned_32) return Unsigned_32;
procedure Update (CRC_Value : in out Unsigned_32; val : Unsigned_8);
pragma Inline (Update);
end CRC;
package body CRC is
CRC32_Table :
constant array (Unsigned_32′(0) .. 255) of Unsigned_32 := (
16#00000000#, 16#04c11db7#, 16#09823b6e#, 16#0d4326d9#,
16#130476dc#, 16#17c56b6b#, 16#1a864db2#, 16#1e475005#,
16#2608edb8#, 16#22c9f00f#, 16#2f8ad6d6#, 16#2b4bcb61#,
16#350c9b64#, 16#31cd86d3#, 16#3c8ea00a#, 16#384fbdbd#,
16#4c11db70#, 16#48d0c6c7#, 16#4593e01e#, 16#4152fda9#,
16#5f15adac#, 16#5bd4b01b#, 16#569796c2#, 16#52568b75#,
16#6a1936c8#, 16#6ed82b7f#, 16#639b0da6#, 16#675a1011#,
16#791d4014#, 16#7ddc5da3#, 16#709f7b7a#, 16#745e66cd#,
16#9823b6e0#, 16#9ce2ab57#, 16#91a18d8e#, 16#95609039#,
16#8b27c03c#, 16#8fe6dd8b#, 16#82a5fb52#, 16#8664e6e5#,
16#be2b5b58#, 16#baea46ef#, 16#b7a96036#, 16#b3687d81#,
16#ad2f2d84#, 16#a9ee3033#, 16#a4ad16ea#, 16#a06c0b5d#,
16#d4326d90#, 16#d0f37027#, 16#ddb056fe#, 16#d9714b49#,
16#c7361b4c#, 16#c3f706fb#, 16#ceb42022#, 16#ca753d95#,
16#f23a8028#, 16#f6fb9d9f#, 16#fbb8bb46#, 16#ff79a6f1#,
16#e13ef6f4#, 16#e5ffeb43#, 16#e8bccd9a#, 16#ec7dd02d#,
16#34867077#, 16#30476dc0#, 16#3d044b19#, 16#39c556ae#,
16#278206ab#, 16#23431b1c#, 16#2e003dc5#, 16#2ac12072#,
16#128e9dcf#, 16#164f8078#, 16#1b0ca6a1#, 16#1fcdbb16#,
16#018aeb13#, 16#054bf6a4#, 16#0808d07d#, 16#0cc9cdca#,
16#7897ab07#, 16#7c56b6b0#, 16#71159069#, 16#75d48dde#,
16#6b93dddb#, 16#6f52c06c#, 16#6211e6b5#, 16#66d0fb02#,
16#5e9f46bf#, 16#5a5e5b08#, 16#571d7dd1#, 16#53dc6066#,
16#4d9b3063#, 16#495a2dd4#, 16#44190b0d#, 16#40d816ba#,
16#aca5c697#, 16#a864db20#, 16#a527fdf9#, 16#a1e6e04e#,
16#bfa1b04b#, 16#bb60adfc#, 16#b6238b25#, 16#b2e29692#,
16#8aad2b2f#, 16#8e6c3698#, 16#832f1041#, 16#87ee0df6#,
16#99a95df3#, 16#9d684044#, 16#902b669d#, 16#94ea7b2a#,
16#e0b41de7#, 16#e4750050#, 16#e9362689#, 16#edf73b3e#,
16#f3b06b3b#, 16#f771768c#, 16#fa325055#, 16#fef34de2#,
16#c6bcf05f#, 16#c27dede8#, 16#cf3ecb31#, 16#cbffd686#,
16#d5b88683#, 16#d1799b34#, 16#dc3abded#, 16#d8fba05a#,
16#690ce0ee#, 16#6dcdfd59#, 16#608edb80#, 16#644fc637#,
16#7a089632#, 16#7ec98b85#, 16#738aad5c#, 16#774bb0eb#,
16#4f040d56#, 16#4bc510e1#, 16#46863638#, 16#42472b8f#,
16#5c007b8a#, 16#58c1663d#, 16#558240e4#, 16#51435d53#,
16#251d3b9e#, 16#21dc2629#, 16#2c9f00f0#, 16#285e1d47#,
16#36194d42#, 16#32d850f5#, 16#3f9b762c#, 16#3b5a6b9b#,
16#0315d626#, 16#07d4cb91#, 16#0a97ed48#, 16#0e56f0ff#,
16#1011a0fa#, 16#14d0bd4d#, 16#19939b94#, 16#1d528623#,
16#f12f560e#, 16#f5ee4bb9#, 16#f8ad6d60#, 16#fc6c70d7#,
16#e22b20d2#, 16#e6ea3d65#, 16#eba91bbc#, 16#ef68060b#,
16#d727bbb6#, 16#d3e6a601#, 16#dea580d8#, 16#da649d6f#,
16#c423cd6a#, 16#c0e2d0dd#, 16#cda1f604#, 16#c960ebb3#,
16#bd3e8d7e#, 16#b9ff90c9#, 16#b4bcb610#, 16#b07daba7#,
16#ae3afba2#, 16#aafbe615#, 16#a7b8c0cc#, 16#a379dd7b#,
16#9b3660c6#, 16#9ff77d71#, 16#92b45ba8#, 16#9675461f#,
16#8832161a#, 16#8cf30bad#, 16#81b02d74#, 16#857130c3#,
16#5d8a9099#, 16#594b8d2e#, 16#5408abf7#, 16#50c9b640#,
16#4e8ee645#, 16#4a4ffbf2#, 16#470cdd2b#, 16#43cdc09c#,
16#7b827d21#, 16#7f436096#, 16#7200464f#, 16#76c15bf8#,
16#68860bfd#, 16#6c47164a#, 16#61043093#, 16#65c52d24#,
16#119b4be9#, 16#155a565e#, 16#18197087#, 16#1cd86d30#,
16#029f3d35#, 16#065e2082#, 16#0b1d065b#, 16#0fdc1bec#,
16#3793a651#, 16#3352bbe6#, 16#3e119d3f#, 16#3ad08088#,
16#2497d08d#, 16#2056cd3a#, 16#2d15ebe3#, 16#29d4f654#,
16#c5a92679#, 16#c1683bce#, 16#cc2b1d17#, 16#c8ea00a0#,
16#d6ad50a5#, 16#d26c4d12#, 16#df2f6bcb#, 16#dbee767c#,
16#e3a1cbc1#, 16#e760d676#, 16#ea23f0af#, 16#eee2ed18#,
16#f0a5bd1d#, 16#f464a0aa#, 16#f9278673#, 16#fde69bc4#,
16#89b8fd09#, 16#8d79e0be#, 16#803ac667#, 16#84fbdbd0#,
16#9abc8bd5#, 16#9e7d9662#, 16#933eb0bb#, 16#97ffad0c#,
16#afb010b1#, 16#ab710d06#, 16#a6322bdf#, 16#a2f33668#,
16#bcb4666d#, 16#b8757bda#, 16#b5365d03#, 16#b1f740b4#
);
procedure Update (CRC_Value : in out Unsigned_32; val : Unsigned_8) is
begin
CRC_Value :=
CRC32_Table (16#FF# and (Shift_Right (CRC_Value, 24) xor Unsigned_32 (val)))
xor
Shift_Left (CRC_Value, 8);
end Update;
procedure Init (CRC_Value : out Unsigned_32) is
begin
CRC_Value := 16#FFFF_FFFF#;
end Init;
function Final (CRC_Value : Unsigned_32) return Unsigned_32 is
begin
return not CRC_Value;
end Final;
end CRC;
compare_final_CRC : Boolean := False;
stored_blockcrc, mem_stored_blockcrc, computed_crc : Unsigned_32;
— Decode a new compressed block.
function decode_block return Boolean is
magic : String (1 .. 6);
begin
for i in 1 .. 6 loop
magic (i) := Character’Val (get_byte);
end loop;
if magic = “1AY&SY” then
if check_CRC then
if compare_final_CRC then
null; — initialisation is delayed until the rle buffer is empty
else
CRC.Init (computed_crc); — Initialize for next block.
end if;
end if;
stored_blockcrc := get_cardinal;
block_randomized := get_boolean;
block_origin := Natural (get_cardinal24);
— Receive the mapping table.
receive_mapping_table;
global_alpha_size := inuse_count + 2;
— Receive the selectors.
receive_selectors;
— Undo the MTF values for the selectors.
undo_mtf_values;
— Receive the coding tables.
receive_coding_tables;
— Build the Huffman tables.
make_hufftab;
— Receive the MTF values.
receive_mtf_values;
— Undo the Burrows Wheeler transformation.
detransform;
decode_available := tt_count;
return True;
elsif magic = Character’Val (16#17#) & “rE8P” & Character’Val (16#90#) then
return False;
else
raise bad_block_magic;
end if;
end decode_block;
next_rle_idx : Integer := -2;
buf : Buffer (1 .. output_buffer_size);
last : Natural;
procedure Read_Local is
shorten : Natural := 0;
procedure rle_read is
rle_len : Natural;
data : Unsigned_8;
idx : Integer := buf’First;
count : Integer := buf’Length;
—
procedure rle_write is
pragma Inline (rle_write);
begin
loop
buf (idx) := data;
idx := idx + 1;
count := count – 1;
rle_len := rle_len – 1;
if check_CRC then
CRC.Update (computed_crc, data);
if rle_len = 0 and then compare_final_CRC then
if CRC.Final (computed_crc) /= mem_stored_blockcrc then
raise block_crc_check_failed;
end if;
compare_final_CRC := False;
CRC.Init (computed_crc); — Initialize for next block.
end if;
end if;
exit when rle_len = 0 or else count = 0;
end loop;
end rle_write;
—
— handle extreme cases of data of length 1, 2
input_dried : exception;
—
— Make next_rle_idx index to the next decoded byte.
— If next_rle_idx did index to the last
— byte in the current block, decode the next block.
—
procedure consume_rle is
pragma Inline (consume_rle);
begin
next_rle_idx := Integer (Shift_Right (tt.all (next_rle_idx), 8));
decode_available := decode_available – 1;
if decode_available = 0 then
compare_final_CRC := True;
mem_stored_blockcrc := stored_blockcrc;
— ^ There might be a new block when last block’s
— rle is finally emptied.
—
— ** New block
if decode_block then
next_rle_idx := Natural (Shift_Right (tt.all (block_origin), 8));
else
next_rle_idx := -1;
end_reached := True;
end if;
— **
if end_reached then
raise input_dried;
end if;
end if;
end consume_rle;
—
function rle_byte return Unsigned_8 is
pragma Inline (rle_byte);
begin
return Unsigned_8 (tt.all (next_rle_idx) and 16#FF#);
end rle_byte;
—
function rle_possible return Boolean is
pragma Inline (rle_possible);
begin
return decode_available > 0 and then data = rle_byte;
end rle_possible;
—
begin — rle_read
rle_len := rle_run_left;
data := rle_run_data;
if block_randomized then
raise randomized_not_yet_implemented;
end if;
if rle_len /= 0 then
rle_write;
if count = 0 then
shorten := 0;
rle_run_data := data;
rle_run_left := rle_len;
return;
end if;
end if;
begin
— The big loop
loop
if decode_available = 0 or else end_reached then
exit;
end if;
rle_len := 1;
data := rle_byte;
consume_rle;
if rle_possible then
rle_len := rle_len + 1;
consume_rle;
if rle_possible then
rle_len := rle_len + 1;
consume_rle;
if rle_possible then
consume_rle;
rle_len := rle_len + Natural (rle_byte) + 1;
consume_rle;
end if;
end if;
end if;
rle_write;
exit when count = 0;
end loop;
exception
when input_dried => rle_write;
end;
shorten := count;
rle_run_data := data;
rle_run_left := rle_len;
end rle_read;
begin — read
last := buf’Last;
if decode_available = Natural’Last then
— Initialize the rle process:
— – Decode a block
— – Initialize pointer.
if decode_block then
next_rle_idx := Natural (Shift_Right (tt.all (block_origin), 8));
else
next_rle_idx := -1;
end_reached := True;
end if;
end if;
rle_read;
last := last – shorten;
end Read_Local;
begin
Init;
loop
Read_Local;
Write (buf (1 .. last));
exit when end_reached and then rle_run_left = 0;
end loop;
Dispose (tt); pragma Unreferenced (tt);
end Decompress;
end BZip2;