HILE (n>0)AND(CLen^[PRED(n)]=0) DO
DEC(n);
PutBits(CBIT,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
FOR k:=0 TO PRED(Count) DO
PutBits(PtLen[0],PtCode[0])
ELSE
IF Count<=18 THEN
BEGIN
PutBits(PtLen[1],PtCode[1]);
PutBits(4,Count-3);
END ELSE
IF Count=19 THEN
BEGIN
PutBits(PtLen[0],PtCode[0]);
PutBits(PtLen[1],PtCode[1]);
PutBits(4,15);
END ELSE BEGIN
PutBits(PtLen[2],PtCode[2]);
PutBits(CBIT,Count-20);
END;
END ELSE
PutBits(PtLen[k+2],PtCode[k+2]);
END;
END;
PROCEDURE EncodeC(c:TwoByteInt);
BEGIN
PutBits(CLen^[c],CCode[c]);
END;
PROCEDURE EncodeP(p:Word);
VAR
c,q:Word;
BEGIN
c:=0;q:=p;
WHILE q<>0 DO BEGIN
q:=q SHR 1;INC(c);
END;
PutBits(PtLen[c],PtCode[c]);
IF c>1 THEN
PutBits(PRED(c),p AND ($ffff SHR (17-c)));
END;
PROCEDURE SendBlock;
VAR
i,k,flags,root,Pos,Size:Word;
BEGIN
root:=MakeTree(NC,@CFreq,PByte(CLen),@CCode);
Size:=CFreq[root];
PutBits(16,Size);
IF root>=NC THEN
BEGIN
CountTFreq;
root:=MakeTree(NT,@TFreq,@PtLen,@PtCode);
IF root>=NT THEN
WritePtLen(NT,TBIT,3)
ELSE
BEGIN
PutBits(TBIT,0);
PutBits(TBIT,root);
END;
WriteCLen;
END ELSE BEGIN
PutBits(TBIT,0);
PutBits(TBIT,0);
PutBits(CBIT,0);
PutBits(CBIT,root);
END;
root:=MakeTree(NP,@PFreq,@PtLen,@PtCode);
IF root>=NP THEN
WritePtLen(NP,PBIT,-1)
ELSE
BEGIN
PutBits(PBIT,0);
PutBits(PBIT,root);
END;
Pos:=0;
FOR i:=0 TO PRED(Size) DO BEGIN
IF (i AND 7)=0 THEN
BEGIN
flags:=Buf^[Pos];INC(Pos);
END ELSE
flags:=flags SHL 1;
IF (flags AND (1 SHL 7))<>0 THEN
BEGIN
k:=Buf^[Pos]+(1 SHL 8);INC(Pos);EncodeC(k);
k:=Buf^[Pos]SHL 8;INC(Pos);INC(k,Buf^[Pos]);INC(Pos);EncodeP(k);
END ELSE BEGIN
k:=Buf^[Pos];INC(Pos);EncodeC(k);
END;
END;
FOR i:=0 TO PRED(NC) DO
CFreq[i]:=0;
FOR i:=0 TO PRED(NP) DO
PFreq[i]:=0;
END;
PROCEDURE Output(c,p:Word);
BEGIN
OutputMask:=OutputMask SHR 1;
IF OutputMask=0 THEN
BEGIN
OutputMask:=1 SHL 7;
IF (OutputPos>=WINDOWSIZE-24) THEN
BEGIN
SendBlock;OutputPos:=0;
END;
CPos:=OutputPos;INC(OutputPos);Buf^[CPos]:=0;
END;
Buf^[OutputPos]:=c;INC(OutputPos);INC(CFreq[c]);
IF c>=(1 SHL 8) THEN
BEGIN
Buf^[CPos]:=Buf^[CPos] OR OutputMask;
Buf^[OutputPos]:=(p SHR 8);INC(OutputPos);
Buf^[OutputPos]:=p;INC(OutputPos);c:=0;
WHILE p<>0 DO BEGIN
p:=p SHR 1;INC(c);
END;
INC(PFreq[c]);
END;
END;
{------------------------------- Lempel-Ziv part ------------------------------}
PROCEDURE InitSlide;
VAR
i:Word;
BEGIN
FOR i:=DICSIZ TO (DICSIZ+UCHARMAX) DO BEGIN
Level^[i]:=1;
{$IFDEF PERCOLATE}
Position^[i]:=NUL;
{$ENDIF}
END;
FOR i:=DICSIZ TO PRED(2*DICSIZ) DO
Parent^[i]:=NUL;
Avail:=1;
FOR i:=1 TO DICSIZ-2 DO
Next^[i]:=SUCC(i);
Next^[PRED(DICSIZ)]:=NUL;
FOR i:=(2*DICSIZ) TO MAXHASHVAL DO
Next^[i]:=NUL;
END;
{ Hash function }
FUNCTION Hash(p:TwoByteInt;c:Byte):TwoByteInt;
BEGIN
Hash:=p+(c SHL (DICBIT-9))+2*DICSIZ;
END;
FUNCTION Child(q:TwoByteInt;c:Byte):TwoByteInt;
VAR
r:TwoByteInt;
BEGIN
r:=Next^[Hash(q,c)];Parent^[NUL]:=q;
WHILE Parent^[r]<>q DO
r:=Next^[r];
Child:=r;
END;
PROCEDURE MakeChild(q:TwoByteInt;c:Byte;r:TwoByteInt);
VAR
h,t:TwoByteInt;
BEGIN
h:=Hash(q,c);
t:=Next^[h];Next^[h]:=r;Next^[r]:=t;
Prev^[t]:=r;Prev^[r]:=h;Parent^[r]:=q;
INC(ChildCount^[q]);
END;
PROCEDURE Split(old:TwoByteInt);
VAR
new,t:TwoByteInt;
BEGIN
new:=Avail;Avail:=Next^[new];
ChildCount^[new]:=0;
t:=Prev^[old];Prev^[new]:=t;
Next^[t]:=new;
t:=Next^[old];Next^[new]:=t;
Prev^[t]:=new;
Parent^[new]:=Parent^[old];
Level^[new]:=MatchLen;
Position^[new]:=Pos;
MakeChild(new,Text^[MatchPos+MatchLen],old);
MakeChild(new,Text^[Pos+MatchLen],Pos);
END;
PROCEDURE InsertNode;
VAR
q,r,j,t:TwoByteInt;
c:Byte;
t1,t2:PChar;
BEGIN
IF MatchLen>=4 THEN
BEGIN
DEC(MatchLen);
r:=SUCC(MatchPos) OR DICSIZ;
q:=Parent^[r];
WHILE q=NUL DO BEGIN
r:=Next^[r];q:=Parent^[r];
END;
WHILE Level^[q]>=MatchLen DO BEGIN
r:=q;q:=Parent^[q];
END;
t:=q;
{$IFDEF PERCOLATE}
WHILE Position^[t]<0 DO BEGIN
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
上一页 [1] [2] [3] [4] [5] [6] [7] 下一页 |
