abdfenc.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

    {calculate the code lengths array as a stream of items}
    CodeLenStream := TAbDfCodeLenStream.Create(aLog);
    CodeLenStream.Build(CodeLens, LitCodeCount + DistCodeCount);

    {calculate the codelengths for the code lengths}
    GenerateCodeLengths(7, CodeLenStream.Buckets^, CLCodeLens, 0, nil);

    {calculate the number of the used codelengths for the code lengths}
    LenCodeCount := 19;
    repeat
      dec(LenCodeCount);
    until (CLCodeLens[dfc_CodeLengthIndex[LenCodeCount]] <> 0);
    inc(LenCodeCount);
    {..there's a minimum of four, though}
    if (LenCodeCount < 4) then
      LenCodeCount := 4;

    {if we have to work out and use the best method...}
    if aUseBest then begin

      {calculate the number of bits required for the compressed data
       using dynamic huffman trees}
      BitCount := CalcDynamicBitCount(aUseDeflate64,
                                      aStream.LitBuckets,
                                      aStream.DistBuckets,
                                      CodeLenStream.Buckets,
                                      CodeLens,
                                      CLCodeLens,
                                      LitCodeCount,
                                      DistCodeCount,
                                      LenCodeCount);

      {choose the algorithm with the smallest size}
      StaticSize := aStream.StaticSize;
      StoredSize := (aStream.StoredSize + 4) * 8;
      if (StaticSize < BitCount) then begin
        if (StoredSize < StaticSize) then
          EncodeLZStreamStored(aFinalBlock, aStream, aBitStrm,
                               (StoredSize div 8) - 4, aLog)
        else
          EncodeLZStreamStatic(aFinalBlock, aUseDeflate64,
                               aStream, aBitStrm, aLog);
        Exit;
      end
      else if (StoredSize < BitCount) then begin
        EncodeLZStreamStored(aFinalBlock, aStream, aBitStrm,
                             (StoredSize div 8) - 4, aLog);
        Exit;
      end;
    end;

    {create the code lengths tree}
    CodeLenTree := TAbDfDecodeHuffmanTree.Create(19, 7, huEncoding);
    CodeLenTree.Build(CLCodeLens, 0, 19, [0], $FFFF);

    {$IFDEF UseLogging}
    {log the tree}
    if (aLog <> nil) then begin
      aLog.WriteLine('Code lengths tree');
      CodeLenTree.DebugPrint(aLog);
    end;
    {$ENDIF}

    {calculate the literal encoding tree}
    LitTree := TAbDfDecodeHuffmanTree.Create(286, 15, huEncoding);
    LitTree.Build(CodeLens, 0, LitCodeCount,
                                  dfc_LitExtraBits, dfc_LitExtraOffset);

    {$IFDEF UseLogging}
    {log the tree}
    if (aLog <> nil) then begin
      aLog.WriteLine('Literal/length tree');
      LitTree.DebugPrint(aLog);
    end;
    {$ENDIF}

    {calculate the distance tree}
    if aUseDeflate64 then
      DistTree := TAbDfDecodeHuffmanTree.Create(32, 15, huEncoding)
    else
      DistTree := TAbDfDecodeHuffmanTree.Create(30, 15, huEncoding);
    DistTree.Build(CodeLens, LitCodeCount, DistCodeCount,
                                dfc_DistExtraBits, dfc_DistExtraOffset);

    {$IFDEF UseLogging}
    if (aLog <> nil) then begin
      {log the tree}
      aLog.WriteLine('Distance tree');
      DistTree.DebugPrint(aLog);

      {log the new block}
      aLog.WriteLine('..Writing new block...');
      aLog.WriteLine(Format('..final block? %d', [ord(aFinalBlock)]));
      aLog.WriteLine('..block type? 2');
      aLog.WriteLine(Format('Count of literals:     %d', [LitCodeCount]));
      aLog.WriteLine(Format('Count of distances:    %d', [DistCodeCount]));
      aLog.WriteLine(Format('Count of code lengths: %d', [LenCodeCount]));
    end;
    {$ENDIF}

    {output the block information to the bit stream}
    if aFinalBlock then
      Code := 1 + (2 shl 1)
    else
      Code := 0 + (2 shl 1);
    aBitStrm.WriteBits(Code, 3);

    {output the various counts to the bit stream}
    Code := (LitCodeCount - 257) +
            ((DistCodeCount - 1) shl 5) +
            ((LenCodeCount - 4) shl 10);
    aBitStrm.WriteBits(Code, 14);

    {output the code length codelengths to the bit stream}
    for i := 0 to pred(LenCodeCount) do
      aBitStrm.WriteBits(CLCodeLens[dfc_CodeLengthIndex[i]], 3);

    {encode and write the codelength stream to the bit stream}
    CodeLenStream.Encode(aBitStrm, CodeLenTree);

    {encode and write the LZ77 stream to the bit stream}
    aStream.Encode(aBitStrm, LitTree, DistTree, aUseDeflate64);

    {output the end-of-block marker to the bit stream}
    OutputEndOfBlock(aBitStrm, LitTree);
    {$IFDEF UseLogging}
    if (aLog <> nil) then
      aLog.WriteLine('Char: end-of-block marker (#256)');
    {$ENDIF}

  finally
    LitTree.Free;
    DistTree.Free;
    CodeLenTree.Free;
    CodeLenStream.Free;
  end;
end;
{====================================================================}


{===Single algorithm Static/Dynamic Huffman tree deflate=============}
function DeflateStaticDynamic(aStatic : boolean;
                              aUseBest: boolean;
                              aSource : TStream; aDest : TStream;
                              aHelper : TAbDeflateHelper;
                              aLog    : TAbLogger) : longint;
var
  i : integer;
  SlideWin     : TAbDfInputWindow;
  BitStrm      : TAbDfOutBitStream;
  LZ77Stream   : TAbDfLZStream;
  KeyLen       : integer;
  Match        : TAbDfMatch;
  PrevMatch    : TAbDfMatch;
  UseDeflate64 : boolean;
  UseCRC32     : boolean;
  GotMatch     : boolean;
  LZStrmIsFull : boolean;
  TestForBinary: boolean;
begin
  {note: turn on the following define to see when and how the lazy
         matching algorithm works}
  {$IFDEF UseLogging}
    {$DEFINE UseLazyMatchLogging}
  {$ENDIF}

  {$IFDEF UseLogging}
  if (aLog <> nil) then
    if aStatic then
      aLog.WriteLine('..compressing source data with static huffman trees')
    else
      aLog.WriteLine('..compressing source data with dynamic huffman trees');
  {$ENDIF}

  {prepare for the try..finally}
  SlideWin := nil;
  BitStrm := nil;
  LZ77Stream := nil;
  try

    {create the sliding window}
    UseDeflate64 := (aHelper.Options and dfc_UseDeflate64) <> 0;
    UseCRC32 := (aHelper.Options and dfc_UseAdler32) = 0;
    SlideWin := TAbDfInputWindow.Create(aSource,
                                        aHelper.StreamSize,
                                        aHelper.WindowSize,
                                        aHelper.ChainLength,
                                        UseDeflate64, UseCRC32);
    SlideWin.OnProgress := aHelper.OnProgressStep;

    {create the bit stream}
    BitStrm := TAbDfOutBitStream.Create(aDest);

    {create the LZ77 stream}
    LZ77Stream := TAbDfLZStream.Create(SlideWin, UseDeflate64, aLog);
    LZStrmIsFull := false;
    TestForBinary := true;

    {set the previous match to be a literal character: this will
     ensure that no lazy matching goes on with the first key read}
    PrevMatch.maLen := 0;

    {get the first key length}
    KeyLen := SlideWin.GetNextKeyLength;

    {while the current key is three characters long...}
    while (KeyLen = 3) do begin

      {tweak for binary/text}
      {note: the test for whether a stream is binary or not is to
             check whether there are any #0 characters in the first
             1024 bytes: if there are the stream is binary.
             this test and tweaking is based on experimentation
             compression ratios for binary and text files based on the
             PKZIP 'n' option.}
      if TestForBinary and (LZ77Stream.StoredSize = 1024) then begin
        if (aHelper.PKZipOption = 'n') then
          if (LZ77Stream.LitBuckets^[0] = 0) then begin
            aHelper.AmpleLength := aHelper.AmpleLength * 2;
            aHelper.MaxLazyLength := aHelper.MaxLazyLength * 2;
            aHelper.ChainLength := aHelper.ChainLength * 2;
            SlideWin.ChainLen := aHelper.ChainLength;
          end;
        TestForBinary := false;
      end;

      {if the LZ77 stream is full, empty it}
      if LZStrmIsFull then begin
        if aStatic then
          EncodeLZStreamStatic(false, UseDeflate64,
                               LZ77Stream, BitStrm, aLog)
        else
          EncodeLZStreamDynamic(false, UseDeflate64, aUseBest,
                                LZ77Stream, BitStrm, aLog);
        LZ77Stream.Clear;
        LZStrmIsFull := false;
      end;

      {try and find a match of three or more characters (note: this
       has the side effect of adding the current key to the internal
       hash table); this routine will only return true if it finds a
       match greater than the previous match}
      GotMatch := SlideWin.FindLongestMatch(aHelper.AmpleLength,
                                            Match, PrevMatch);

      {if the maximum match length were three and the distance exceeds
       4096 bytes, it's most likely that we'll get better compression
       by outputting the three literal bytes rather than by outputting
       a length symbol, a distance symbol, and at least ten extra
       bits for the extra distance value}
      if (Match.maLen = 3) and (Match.maDist > 4096) then
        GotMatch := false;

      {if we found a match...}
      if GotMatch then begin

        {if there were no previous match, we can't do any lazy match
         processing now, so save the current match details ready for
         lazy matching the next time through, and advance the sliding
         window}
        if (PrevMatch.maLen = 0) then begin
          PrevMatch.maLen := Match.maLen;
          PrevMatch.maDist := Match.maDist;
          PrevMatch.maLit := Match.maLit;
          SlideWin.AdvanceByOne;
        end

        {otherwise the previous match is smaller than this one, so
         we're going to accept this match in preference; throw away
         the previous match, output the previous literal character
         instead and save these match details}
        else begin
          {$IFDEF UseLazyMatchLogging}
          if (aLog <> nil) then
            aLog.WriteLine(
               Format(
                  '..this match longer, rejecting previous one (%d,%d)',
                  [PrevMatch.maLen, PrevMatch.maDist]));
          {$ENDIF}
          LZStrmIsFull := LZ77Stream.AddLiteral(PrevMatch.maLit);
          PrevMatch.maLen := Match.maLen;
          PrevMatch.maDist := Match.maDist;
          PrevMatch.maLit := Match.maLit;
          SlideWin.AdvanceByOne;
        end;

        {if, by this point, we're storing up a match, check to see
         if it equals or exceeds the maximum lazy match length; if
         it does then output the match right now and avoid checking
         for a lazy match}
        if (PrevMatch.maLen >= aHelper.MaxLazyLength) then begin
          {$IFDEF UseLazyMatchLogging}
          if (aLog <> nil) then
            if ((aHelper.Options and dfc_UseLazyMatch) <> 0) then
              aLog.WriteLine('..match longer than max lazy match, using it');
          {$ENDIF}
          LZStrmIsFull :=
             LZ77Stream.AddLenDist(PrevMatch.maLen, PrevMatch.maDist);
          SlideWin.Advance(PrevMatch.maLen - 1, PrevMatch.maLen - 1);
          PrevMatch.maLen := 0;
        end;
      end

      {otherwise, we don't have a match at all: so we possibly just
       need to output a literal character}
      else begin
        {if there was a previous match, output it and discard the
         results of this match}