数据压缩 -- 源码[4]

  depth:word;

  buf:pbyte;

  cfreq:array[0..2*(nc-1)]of word;
  pfreq:array[0..2*(np-1)]of word;
  tfreq:array[0..2*(nt-1)]of word;

  ccode:array[0..pred(nc)]of word;
  ptcode:array[0..pred(npt)]of word;

  cpos,outputpos,outputmask:word;
  text,childcount:pbyte;

  pos,matchpos,avail:word;
  position,parent,prev,next:pword;

  remainder,matchlen:twobyteint;
  level:pbyte;

{********************************** file i/o **********************************}

function getc:byte;
begin
  if bufptr=0 then
    infile.read(buffer^,bufsize);
  getc:=buffer^[bufptr];bufptr:=succ(bufptr)and pred(bufsize);
end;

procedure putc(c:byte);
begin
  if bufptr=bufsize then
    begin
      outfile.write(buffer^,bufsize);bufptr:=0;
    end;
  buffer^[bufptr]:=c;inc(bufptr);
end;

function bread(p:pointer;n:twobyteint):twobyteint;
begin
  bread := infile.read(p^,n);
end;

procedure bwrite(p:pointer;n:twobyteint);
begin
  outfile.write(p^,n);
end;

{**************************** bit handling routines ***************************}

procedure fillbuf(n:twobyteint);
begin
  bitbuf:=(bitbuf shl n);
  while n>bitcount do begin
    dec(n,bitcount);
    bitbuf:=bitbuf or (subbitbuf shl n);
    if (compsize<>0) then
      begin
        dec(compsize);subbitbuf:=getc;
      end else
        subbitbuf:=0;
    bitcount:=8;
  end;
  dec(bitcount,n);
  bitbuf:=bitbuf or (subbitbuf shr bitcount);
end;

function getbits(n:twobyteint):word;
begin
  getbits:=bitbuf shr (bitbufsiz-n);
  fillbuf(n);
end;

procedure putbits(n:twobyteint;x:word);
begin
  if n<bitcount then
    begin
      dec(bitcount,n);
      subbitbuf:=subbitbuf or (x shl bitcount);
    end else begin
      dec(n,bitcount);
      putc(subbitbuf or (x shr n));inc(compsize);
      if n<8 then
        begin
          bitcount:=8-n;subbitbuf:=x shl bitcount;
        end else begin
          putc(x shr (n-8));inc(compsize);
          bitcount:=16-n;subbitbuf:=x shl bitcount;
        end;
    end;
end;

procedure initgetbits;
begin
  bitbuf:=0;subbitbuf:=0;bitcount:=0;fillbuf(bitbufsiz);
end;

procedure initputbits;
begin
  bitcount:=8;subbitbuf:=0;
end;

{******************************** decompression *******************************}

procedure maketable(nchar:twobyteint;bitlen:pbyte;tablebits:twobyteint;table:pword);
var
  count,weight:array[1..16]of word;
  start:array[1..17]of word;
  p:pword;
  i,k,len,ch,jutbits,avail,nextcode,mask:twobyteint;
begin
  for i:=1 to 16 do
    count[i]:=0;
  for i:=0 to pred(nchar) do
    inc(count[bitlen^[i]]);
  start[1]:=0;
  for i:=1 to 16 do
    start[succ(i)]:=start[i]+(count[i] shl (16-i));
  if start[17]<>0 then
    halt(1);
  jutbits:=16-tablebits;
  for i:=1 to tablebits do
    begin
      start[i]:=start[i] shr jutbits;weight[i]:=1 shl (tablebits-i);
    end;
  i:=succ(tablebits);
  while (i<=16) do begin
    weight[i]:=1 shl (16-i);inc(i);
  end;
  i:=start[succ(tablebits)] shr jutbits;
  if i<>0 then
    begin
      k:=1 shl tablebits;