Source file : bzip2_decoding.adb
-- See bzip2_decoding.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_Decoding 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;
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;
limit,
base ,
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 : in 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 .. 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 .. 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(
limit(t), base(t), perm(t), len(t),
minlen, maxlen, 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 > limit(gsel)(zn) loop
zn:= zn + 1;
zvec:= Shift_Left(zvec, 1) or get_bits_32(1);
end loop;
return perm(gsel)(Natural(zvec-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(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(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(p) and 16#ff#);
r:= cftab(i255);
cftab(i255):= cftab(i255) + 1;
tt(r):= tt(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: out Unsigned_32 );
function Final( CRC: Unsigned_32 ) return Unsigned_32;
procedure Update( CRC: 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: in out Unsigned_32; val: Unsigned_8 ) is
begin
CRC :=
CRC32_Table( 16#FF# and ( Shift_Right(CRC, 24) xor Unsigned_32( val ) ) )
xor
Shift_Left( CRC , 8 );
end Update;
procedure Init( CRC: out Unsigned_32 ) is
begin
CRC:= 16#FFFF_FFFF#;
end Init;
function Final( CRC: Unsigned_32 ) return Unsigned_32 is
begin
return not CRC;
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;
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 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 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(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(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(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 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(block_origin), 8));
else
next_rle_idx:= -1;
end_reached:= True;
end if;
end if;
rle_read;
last:= last - shorten;
end Read;
begin
Init;
loop
Read;
Write( buf(1..last) );
exit when end_reached and rle_run_left = 0;
end loop;
Dispose(tt);
end Decompress;
end BZip2_Decoding;
Zip-Ada: Ada library for zip archive files (.zip).
Ada programming.
Some news about Zip-Ada and other related Ada projects
on Gautier's blog.
