数据压缩 -- 源码

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;
WHILE i<>k DO BEGIN
Table^[i]:=0;INC(i);
END;
END;
Avail:=nchar;mask:=1 SHL (15-TableBits);
FOR ch:=0 TO PRED(nchar) DO
BEGIN
Len:=BitLen^[ch];
IF Len=0 THEN
CONTINUE;
k:=start[Len];
nextCode:=k weight[Len];
IF Len<=TableBits THEN
BEGIN
FOR i:=k TO PRED(nextCode) DO
Table^[i]:=ch;
END ELSE BEGIN
p:=Addr(Table^[word(k) SHR jutbits]);i:=Len-TableBits;
WHILE i<>0 DO BEGIN
IF p^[0]=0 THEN
BEGIN
right^[Avail]:=0;left^[Avail]:=0;p^[0]:=Avail;INC(Avail);
END;
IF (k AND mask)<>0 THEN
p:=addr(right^[p^[0]])
ELSE
p:=addr(left^[p^[0]]);
k:=k SHL 1;DEC(i);
END;
p^[0]:=ch;
END;
start[Len]:=nextCode;
END;
END;

PROCEDURE ReadPtLen(nn,nBit,ispecial:TwoByteInt);
VAR
i,c,n:TwoByteInt;
mask:Word;
BEGIN
n:=GetBits(nBit);
IF n=0 THEN
BEGIN
c:=GetBits(nBit);
FOR i:=0 TO PRED(nn) DO
PtLen[i]:=0;
FOR i:=0 TO 255 DO
PtTable[i]:=c;
END ELSE BEGIN
i:=0;
WHILE (i<n) DO BEGIN
c:=BitBuf SHR (BITBUFSIZ-3);
IF c=7 THEN
BEGIN
mask:=1 SHL (BITBUFSIZ-4);
WHILE (mask AND BitBuf)<>0 DO BEGIN
mask:=mask SHR 1;INC(c);
END;
END;
IF c<7 THEN
FillBuf(3)
ELSE
FillBuf(c-3);
PtLen[i]:=c;INC(i);
IF i=ispecial THEN
BEGIN
c:=PRED(TwoByteInt(GetBits(2)));
WHILE c>=0 DO BEGIN
PtLen[i]:=0;INC(i);DEC(c);
END;
END;
END;
WHILE i<nn DO BEGIN
PtLen[i]:=0;INC(i);
END;
MakeTable(nn,@PtLen,8,@PtTable);
END;
END;

PROCEDURE ReadCLen;
VAR
i,c,n:TwoByteInt;
mask:Word;
BEGIN
n:=GetBits(CBIT);
IF n=0 THEN
BEGIN
c:=GetBits(CBIT);
FOR i:=0 TO PRED(NC) DO
CLen^[i]:=0;
FOR i:=0 TO 4095 DO
CTable^[i]:=c;
END ELSE BEGIN
i:=0;
WHILE i<n DO BEGIN
c:=PtTable[BitBuf SHR (BITBUFSIZ-8)];
IF c>=NT THEN
BEGIN
mask:=1 SHL (BITBUFSIZ-9);
REPEAT
IF (BitBuf AND mask)<>0 THEN
c:=right^[c]
ELSE
c:=left^[c];
mask:=mask SHR 1;
UNTIL c<NT;
END;
FillBuf(PtLen[c]);