heap^[i]:=heap^[j];i:=j;j:=i shl 1;
end;
heap^[i]:=k;
end;
procedure makecode(n:twobyteint;len:pbyte;code:pword);
var
i,k:twobyteint;
start:array[0..17] of word;
begin
start[1]:=0;
for i:=1 to 16 do
start[succ(i)]:=(start[i]+lencnt[i])shl 1;
for i:=0 to pred(n) do begin
k:=len^[i];
code^[i]:=start[k];
inc(start[k]);
end;
end;
function maketree(nparm:twobyteint;freqparm:pword;lenparm:pbyte;codeparm:pword):twobyteint;
var
i,j,k,avail:twobyteint;
begin
n:=nparm;freq:=freqparm;len:=lenparm;avail:=n;heapsize:=0;heap^[1]:=0;
for i:=0 to pred(n) do begin
len^[i]:=0;
if freq^[i]<>0 then
begin
inc(heapsize);heap^[heapsize]:=i;
end;
end;
if heapsize<2 then
begin
codeparm^[heap^[1]]:=0;maketree:=heap^[1];
exit;
end;
for i:=(heapsize div 2)downto 1 do downheap(i);
sortptr:=codeparm;
repeat
i:=heap^[1];
if i<n then
begin
sortptr^[0]:=i;
asm
add word ptr sortptr,2; {sortptr:=addr(sortptr^[1]);}
end;
end;
heap^[1]:=heap^[heapsize];dec(heapsize);downheap(1);
j:=heap^[1];
if j<n then
begin
sortptr^[0]:=j;
asm
add word ptr sortptr,2; {sortptr:=addr(sortptr^[1]);}
end;
end;
k:=avail;inc(avail);
freq^[k]:=freq^[i]+freq^[j];heap^[1]:=k;downheap(1);
left^[k]:=i;right^[k]:=j;
until heapsize<=1;
sortptr:=codeparm;
makelen(k);makecode(nparm,lenparm,codeparm);
maketree:=k;
end;
procedure counttfreq;
var
i,k,n,count:twobyteint;
begin
for i:=0 to pred(nt) do
tfreq[i]:=0;n:=nc;
while (n>0)and(clen^[pred(n)]=0) do
dec(n);
i:=0;
while i<n do begin
k:=clen^[i];inc(i);
if k=0 then
begin
count:=1;
while (i<n)and(clen^[i]=0) do begin
inc(i);inc(count);
end;
if count<=2 then
inc(tfreq[0],count)
else
if count<=18 then
inc(tfreq[1])
else
if count=19 then
begin
inc(tfreq[0]);inc(tfreq[1]);
end else
inc(tfreq[2]);
end else
inc(tfreq[k+2]);
end;
end;
procedure writeptlen(n,nbit,ispecial:twobyteint);
var
i,k:twobyteint;
begin
while (n>0)and(ptlen[pred(n)]=0) do
dec(n);
putbits(nbit,n);i:=0;
while (i<n) do begin
k:=ptlen[i];inc(i);
if k<=6 then
putbits(3,k)
else
begin
dec(k,3);
