abdfhufd.pas

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

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Abbrevia
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1997-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* ABBREVIA: AbDfHufD.pas 3.05                           *}
{*********************************************************}
{* Deflate Huffman tree for decoder                      *}
{*********************************************************}

unit AbDfHufD;

{$I AbDefine.inc}

{Activate this compiler define and rebuild if you want the complete
 huffman tree output to print to the current log. The output is
 voluminous to say the least...}
{$IFDEF UseLogging}
{.$DEFINE EnableMegaLog}
{$ENDIF}

{Notes:

The object of this class is to build a decoder array, not to build a
Huffman tree particularly. We don't want to decode huffman strings bit
by bit. moving down the Huffman tree sometimes left, sometimes right.
Instead we want to grab a set of bits and look them up in an array.
Sometimes we'll grab too many bits, sure, but we can deal with that
later. So, the object of the exercise is to calculate the code for a
symbol, reverse it ('cos that's how the input bit stream will present
it to us) and set that element of the array to the decoded symbol
value (plus some extra information: bit lengths).

If the alphabet size were 19 (the codelengths huffman tree) and the
maximum code length 5, for example, the decoder array would be 2^5
elements long, much larger than the alphabet size. The user of this
class will be presenting sets of 5 bits for us to decode. We would
like to look up these 5 bits in the array (as an index) and have the
symbol returned. Now, since the alphabet size is much less than the
number of elements in the decoder array, we must set the other
elements in the array as well. Consider a symbol that has a code of
110 in this scenario. The reversed code is 011, or 3, so we'd be
setting element 3. However we should also be setting elements 01011,
10011, and 11011 to this symbol information as well, since the lookup
will be 5 bits long.

Because the code is a huffman code from a prefix tree, we won't get
any index clashes between actual codes by this "filling in" process.

For the codelength Huffman tree, the maximum code length is at most 7.
This equates to a 128 element array. For the literal and distance
trees, the max code length is at most 15. This equates to a 32768
element array.

For a given lookup value the decoder will return a 32-bit value. The
lower 16 bits is the decoded symbol, the next 8 bits is the code
length for that symbol, the last 8 bits (the most significant) are the
number of extra bits that must be extracted from the input bit stream.
}

interface

uses
  SysUtils,
  Classes,
  AbDfBase;

type
  TAbDfHuffmanUsage = (   {usage of a huffman decoder..}
       huEncoding,        {..encoding}
       huDecoding,        {..decoding}
       huBoth);           {..both (used for static trees)}

  TAbDfDecodeHuffmanTree = class
    private
      FAlphaSize     : integer;
      FDecodes       : PAbDfLongintList;
      FDefMaxCodeLen : integer;
      FEncodes       : PAbDfLongintList;
      {$IFOPT C+}
      FMask          : integer;
      {$ENDIF}
      FMaxCodeLen    : integer;
      FUsage         : TAbDfHuffmanUsage;
    protected
    public
      constructor Create(aAlphabetSize : integer;
                         aDefMaxCodeLen: integer;
                         aUsage        : TAbDfHuffmanUsage);
      destructor Destroy; override;

      procedure Build(const aCodeLengths : array of integer;
                            aStartInx    : integer;
                            aCount       : integer;
                      const aExtraBits   : array of byte;
                            aExtraOffset : integer);
      function Decode(aLookupBits : integer) : longint;
      function Encode(aSymbol : integer) : longint;

      {$IFDEF UseLogging}
      procedure DebugPrint(aLog : TAbLogger);
      {$ENDIF}

      property LookupBitLength : integer read FMaxCodeLen;
      property Decodes : PAbDfLongintList read FDecodes;
      property Encodes : PAbDfLongintList read FEncodes;
  end;

var
  AbStaticLiteralTree  : TAbDfDecodeHuffmanTree;
  AbStaticDistanceTree : TAbDfDecodeHuffmanTree;

implementation

const
  PowerOfTwo : array [0..dfc_MaxCodeLength] of integer =
               (1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048,
                4096, 8192, 16384, 32768);

{===Debug helper routine=============================================}
{$IFDEF EnableMegaLog}
function CodeToStr(aCode : longint; aLen : integer) : string;
var
  i : integer;
begin
  if (aLen = 0) then
    Result := 'no code'
  else begin
    SetLength(Result, 32);
    FillChar(Result[1], 32, ' ');
    for i := 32 downto (33-aLen) do begin
      if Odd(aCode) then
        Result[i] := '1'
      else
        Result[i] := '0';
      aCode := aCode shr 1;
    end;
  end;
end;
{$ENDIF}
{====================================================================}


{===TAbDfDecodeHuffmanTree===========================================}
constructor TAbDfDecodeHuffmanTree.Create(
                                 aAlphabetSize : integer;
                                 aDefMaxCodeLen: integer;
                                 aUsage        : TAbDfHuffmanUsage);
begin
  {protect against dumb programming mistakes}
  Assert(aAlphabetSize >= 2,
         'TAbDfDecodeHuffmanTree.Create: a huffman tree must be for at least two symbols');

  {let the ancestor initialize}
  inherited Create;

  {save the alphabet size, etc}
  FAlphaSize := aAlphabetSize;
  FDefMaxCodeLen := aDefMaxCodeLen;
  FUsage := aUsage;

  {allocate the encoder array (needs to be initialized to zeros)}
  if (aUsage <> huDecoding) then
    FEncodes := AllocMem(FAlphaSize * sizeof(longint));
end;
{--------}
destructor TAbDfDecodeHuffmanTree.Destroy;
begin
  {destroy the codes arrays}
  if (FDecodes <> nil) then
    FreeMem(FDecodes);
  if (FEncodes <> nil) then
    FreeMem(FEncodes);

  {let the ancestor die}
  inherited Destroy;
end;
{--------}
procedure TAbDfDecodeHuffmanTree.Build(
                                const aCodeLengths : array of integer;
                                      aStartInx    : integer;
                                      aCount       : integer;
                                const aExtraBits   : array of byte;
                                      aExtraOffset : integer);
const
  ByteRevTable : array [0..255] of byte = (
   $00, $80, $40, $C0, $20, $A0, $60, $E0, $10, $90, $50, $D0,
   $30, $B0, $70, $F0, $08, $88, $48, $C8, $28, $A8, $68, $E8,
   $18, $98, $58, $D8, $38, $B8, $78, $F8, $04, $84, $44, $C4,
   $24, $A4, $64, $E4, $14, $94, $54, $D4, $34, $B4, $74, $F4,
   $0C, $8C, $4C, $CC, $2C, $AC, $6C, $EC, $1C, $9C, $5C, $DC,
   $3C, $BC, $7C, $FC, $02, $82, $42, $C2, $22, $A2, $62, $E2,
   $12, $92, $52, $D2, $32, $B2, $72, $F2, $0A, $8A, $4A, $CA,
   $2A, $AA, $6A, $EA, $1A, $9A, $5A, $DA, $3A, $BA, $7A, $FA,
   $06, $86, $46, $C6, $26, $A6, $66, $E6, $16, $96, $56, $D6,
   $36, $B6, $76, $F6, $0E, $8E, $4E, $CE, $2E, $AE, $6E, $EE,
   $1E, $9E, $5E, $DE, $3E, $BE, $7E, $FE, $01, $81, $41, $C1,
   $21, $A1, $61, $E1, $11, $91, $51, $D1, $31, $B1, $71, $F1,
   $09, $89, $49, $C9, $29, $A9, $69, $E9, $19, $99, $59, $D9,
   $39, $B9, $79, $F9, $05, $85, $45, $C5, $25, $A5, $65, $E5,
   $15, $95, $55, $D5, $35, $B5, $75, $F5, $0D, $8D, $4D, $CD,
   $2D, $AD, $6D, $ED, $1D, $9D, $5D, $DD, $3D, $BD, $7D, $FD,
   $03, $83, $43, $C3, $23, $A3, $63, $E3, $13, $93, $53, $D3,
   $33, $B3, $73, $F3, $0B, $8B, $4B, $CB, $2B, $AB, $6B, $EB,
   $1B, $9B, $5B, $DB, $3B, $BB, $7B, $FB, $07, $87, $47, $C7,
   $27, $A7, $67, $E7, $17, $97, $57, $D7, $37, $B7, $77, $F7,
   $0F, $8F, $4F, $CF, $2F, $AF, $6F, $EF, $1F, $9F, $5F, $DF,
   $3F, $BF, $7F, $FF);
var
  i : integer;
  Symbol      : integer;
  LengthCount : array [0..dfc_MaxCodeLength] of integer;
  NextCode    : array [0..dfc_MaxCodeLength] of integer;
  Code        : longint;
  CodeLen     : integer;
  CodeData    : longint;
  DecoderLen  : integer;
  CodeIncr    : integer;
  Decodes     : PAbDfLongintList;
  Encodes     : PAbDfLongintList;
  DecodesEnd  : pointer;
  TablePtr    : pointer;
begin
  {count the number of instances of each code length and calculate the
   maximum code length at the same time}
  FillChar(LengthCount, sizeof(LengthCount), 0);
  FMaxCodeLen := 0;
  for i := 0 to pred(aCount) do begin
    CodeLen := aCodeLengths[i + aStartInx];
    Assert((CodeLen <= FDefMaxCodeLen),
           Format('TAbDfDecodeHuffmanTree.Build: a code length is greater than %d',
                  [FDefMaxCodeLen]));
    if (CodeLen > FMaxCodeLen) then