数据压缩 -- 源码[11]

        position^[t]:=pos;t:=parent^[t];
      end;
      if t<dicsiz then
        position^[t]:=pos or percflag;
{$else}
      while t<dicsiz do begin
        position^[t]:=pos;t:=parent^[t];
      end;
{$endif}
    end else begin
      q:=text^[pos]+dicsiz;c:=text^[succ(pos)];r:=child(q,c);
      if r=nul then
        begin
          makechild(q,c,pos);matchlen:=1;
          exit;
        end;
      matchlen:=2;
    end;
  while true do begin
    if r>=dicsiz then
      begin
        j:=maxmatch;matchpos:=r;
      end else begin
        j:=level^[r];matchpos:=position^[r] and not percflag;
      end;
    if matchpos>=pos then
      dec(matchpos,dicsiz);
    t1:=addr(text^[pos+matchlen]);t2:=addr(text^[matchpos+matchlen]);
    while matchlen<j do begin
      if t1^<>t2^ then
        begin
          split(r);
          exit;
        end;
      inc(matchlen);inc(t1);inc(t2);
    end;
    if matchlen>=maxmatch then
      break;
    position^[r]:=pos;q:=r;
    r:=child(q,ord(t1^));
    if r=nul then
      begin
        makechild(q,ord(t1^),pos);
        exit;
      end;
    inc(matchlen);
  end;
  t:=prev^[r];prev^[pos]:=t;next^[t]:=pos;
  t:=next^[r];next^[pos]:=t;prev^[t]:=pos;
  parent^[pos]:=q;parent^[r]:=nul;next^[r]:=pos;
end;

procedure deletenode;
var
  r,s,t,u:twobyteint;
{$ifdef percolate}
  q:twobyteint;
{$endif}
begin
  if parent^[pos]=nul then
    exit;
  r:=prev^[pos];s:=next^[pos];next^[r]:=s;prev^[s]:=r;
  r:=parent^[pos];parent^[pos]:=nul;dec(childcount^[r]);
  if (r>=dicsiz)or(childcount^[r]>1) then
    exit;
{$ifdef percolate}
  t:=position^[r] and not percflag;
{$else}
  t:=position^[r];
{$endif}
  if t>=pos then
    dec(t,dicsiz);
{$ifdef percolate}
  s:=t;q:=parent^[r];u:=position^[q];
  while (u and percflag)<>0 do begin
    u:=u and not percflag;
    if u>=pos then
      dec(u,dicsiz);
    if u>s then
      s:=u;
    position^[q]:=s or dicsiz;q:=parent^[q];u:=position^[q];
  end;
  if q<dicsiz then
    begin
      if u>=pos then
        dec(u,dicsiz);
      if u>s then
        s:=u;
      position^[q]:=s or dicsiz or percflag;
    end;
{$endif}
  s:=child(r,text^[t+level^[r]]);
  t:=prev^[s];u:=next^[s];next^[t]:=u;prev^[u]:=t;
  t:=prev^[r];next^[t]:=s;prev^[s]:=t;
  t:=next^[r];prev^[t]:=s;next^[s]:=t;
  parent^[s]:=parent^[r];parent^[r]:=nul;
  next^[r]:=avail;avail:=r;
end;

procedure getnextmatch;
var
  n:twobyteint;
begin
  dec(remainder);inc(pos);
  if pos=2*dicsiz then
    begin
      move(text^[dicsiz],text^[0],dicsiz+maxmatch);
      n:=infile.read(text^[dicsiz+maxmatch],dicsiz);
      inc(remainder,n);pos:=dicsiz;
    end;
  deletenode;insertnode;
end;

procedure encode;
var
  lastmatchlen,lastmatchpos:twobyteint;
begin
  { initialize encoder variables }