数据压缩 -- 源码[7]

end;

{declared as static vars}
var
  decode_i:word;
  decode_j:twobyteint;

procedure decodebuffer(count:word;buffer:pbyte);
var
  c,r:word;
begin
  r:=0;dec(decode_j);
  while (decode_j>=0) do begin
    buffer^[r]:=buffer^[decode_i];decode_i:=succ(decode_i) and pred(dicsiz);
    inc(r);
    if r=count then
      exit;
    dec(decode_j);
  end;
  while true do begin
    c:=decodec;
    if c<=ucharmax then
      begin
        buffer^[r]:=c;inc(r);
        if r=count then
          exit;
      end else begin
        decode_j:=c-(ucharmax+1-threshold);
        decode_i:=(longint(r)-decodep-1)and pred(dicsiz);
        dec(decode_j);
        while decode_j>=0 do begin
          buffer^[r]:=buffer^[decode_i];
          decode_i:=succ(decode_i) and pred(dicsiz);
          inc(r);
          if r=count then
            exit;
          dec(decode_j);
        end;
      end;
  end;
end;

procedure decode;
var
  p:pbyte;
  l:longint;
  a:word;
begin
  {initialize decoder variables}
  getmem(p,dicsiz);
  initgetbits;blocksize:=0;
  decode_j:=0;
  {skip file size}
  l:=origsize;dec(compsize,4);
  {unpacks the file}
  while l>0 do begin
    if l>dicsiz then
      a:=dicsiz
    else
      a:=l;
    decodebuffer(a,p);
    outfile.write(p^,a);dec(l,a);
  end;
  freemem(p,dicsiz);
end;

{********************************* compression ********************************}

{-------------------------------- huffman part --------------------------------}

procedure countlen(i:twobyteint);
begin
  if i<n then
    begin
      if depth<16 then
        inc(lencnt[depth])
      else
        inc(lencnt[16]);
    end else begin
      inc(depth);
      countlen(left^[i]);countlen(right^[i]);
      dec(depth);
    end;
end;

procedure makelen(root:twobyteint);
var
  i,k:twobyteint;
  cum:word;
begin
  for i:=0 to 16 do
    lencnt[i]:=0;
  countlen(root);cum:=0;
  for i:=16 downto 1 do
    inc(cum,lencnt[i] shl (16-i));
  while cum<>0 do begin
    dec(lencnt[16]);
    for i:=15 downto 1 do
      if lencnt[i]<>0 then
        begin
          dec(lencnt[i]);inc(lencnt[succ(i)],2);
          break;
        end;
    dec(cum);
  end;
  for i:=16 downto 1 do begin
    k:=pred(longint(lencnt[i]));
    while k>=0 do begin
      dec(k);len^[sortptr^[0]]:=i;
      asm
        add word ptr sortptr,2; {sortptr:=addr(sortptr^[1]);}
      end;
    end;
  end;
end;

procedure downheap(i:twobyteint);
var
  j,k:twobyteint;
begin
  k:=heap^[i];j:=i shl 1;
  while (j<=heapsize) do begin
    if (j<heapsize)and(freq^[heap^[j]]>freq^[heap^[succ(j)]]) then inc(j);
    if freq^[k]<=freq^[heap^[j]] then break;