mzlib.pas

lansd aslda sldasdnaslda sdlandslasd

    (fc: (Frequency:  6); dl: (Len: 5)), (fc: (Frequency: 22); dl: (Len: 5)), (fc: (Frequency: 14); dl: (Len: 5)),
    (fc: (Frequency: 30); dl: (Len: 5)), (fc: (Frequency:  1); dl: (Len: 5)), (fc: (Frequency: 17); dl: (Len: 5)),
    (fc: (Frequency:  9); dl: (Len: 5)), (fc: (Frequency: 25); dl: (Len: 5)), (fc: (Frequency:  5); dl: (Len: 5)),
    (fc: (Frequency: 21); dl: (Len: 5)), (fc: (Frequency: 13); dl: (Len: 5)), (fc: (Frequency: 29); dl: (Len: 5)),
    (fc: (Frequency:  3); dl: (Len: 5)), (fc: (Frequency: 19); dl: (Len: 5)), (fc: (Frequency: 11); dl: (Len: 5)),
    (fc: (Frequency: 27); dl: (Len: 5)), (fc: (Frequency:  7); dl: (Len: 5)), (fc: (Frequency: 23); dl: (Len: 5))
  );

  // Distance codes. The first 256 values correspond to the distances 3 .. 258, the last 256 values correspond to the
  // top 8 Bits of the 15 bit distances.
  DistanceCode: array[0..DIST_CODE_LEN - 1] of Byte = (
     0,  1,  2,  3,  4,  4,  5,  5,  6,  6,  6,  6,  7,  7,  7,  7,  8,  8,  8,  8,
     8,  8,  8,  8,  9,  9,  9,  9,  9,  9,  9,  9, 10, 10, 10, 10, 10, 10, 10, 10,
    10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11,
    11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12,
    12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
    13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14,
    14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
    15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,  0,  0, 16, 17,
    18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22,
    23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
    24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
    26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
    26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27,
    27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
    27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
    28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
    28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28,
    28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
    29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
    29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29,
    29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29
  );

  // length code for each normalized match length (0 = MIN_MATCH)
  LengthCode: array[0..MAX_MATCH - MIN_MATCH] of Byte = (
     0,  1,  2,  3,  4,  5,  6,  7,  8,  8,  9,  9, 10, 10, 11, 11, 12, 12, 12, 12,
    13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16,
    17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19,
    19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20,
    21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22,
    22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23,
    23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
    24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
    25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25,
    25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26,
    26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26,
    26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27,
    27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28
  );

  // first normalized length for each code (0 = MIN_MATCH) 
  BaseLength: array[0..LENGTH_CODES - 1] of Integer = (
    0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56,
    64, 80, 96, 112, 128, 160, 192, 224, 0
  );

  // first normalized distance for each code (0 = distance of 1)
  BaseDistance: array[0..D_CODES - 1] of Integer = (
       0,     1,     2,     3,     4,     6,     8,    12,    16,    24,
      32,    48,    64,    96,   128,   192,   256,   384,   512,   768,
    1024,  1536,  2048,  3072,  4096,  6144,  8192, 12288, 16384, 24576
  );

  MIN_LOOKAHEAD = (MAX_MATCH + MIN_MATCH + 1);
  MAX_BL_BITS = 7;              // bit length codes must not exceed MAX_BL_BITS bits
  END_BLOCK = 256;              // end of block literal code
  REP_3_6 = 16;                 // repeat previous bit length 3-6 times (2 Bits of repeat count)
  REPZ_3_10 = 17;               // repeat a zero length 3-10 times  (3 Bits of repeat count)
  REPZ_11_138 = 18;             // repeat a zero length 11-138 times  (7 Bits of repeat count)

  // extra bits for each length code 
  ExtraLengthBits: array[0..LENGTH_CODES - 1] of Integer = (
    0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4, 4, 4, 5, 5, 5, 5, 0
  );

  // extra bits for each distance code 
  ExtraDistanceBits: array[0..D_CODES-1] of Integer = (
    0, 0, 0, 0, 1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9, 10 ,10, 11, 11, 12, 12, 13, 13
  );

  // extra bits for each bit length code
  ExtraBitLengthBits: array[0..BL_CODES - 1] of Integer = (
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 3, 7
  );

  // The lengths of the bit length codes are sent in order of decreasing probability,
  // to avoid transmitting the lengths for unused bit length codes.
  BitLengthOrder: array[0..BL_CODES - 1] of Byte = (
    16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15
  );

  // Number of bits used within BitsBuffer. (BitsBuffer might be implemented on more than 16 bits on some systems.)
  BufferSize = 16;

  StaticLiteralDescriptor: TStaticTreeDescriptor = (
    StaticTree: @StaticLiteralTree;  // pointer to array of TTreeEntry
    ExtraBits: @ExtraLengthBits;     // pointer to array of integer
    ExtraBase: LITERALS + 1;
    Elements: L_CODES;
    MaxLength: MAX_BITS
  );

  StaticDistanceDescriptor: TStaticTreeDescriptor = (
    StaticTree: @StaticDescriptorTree;
    ExtraBits: @ExtraDistanceBits;
    ExtraBase: 0;
    Elements: D_CODES;
    MaxLength: MAX_BITS
  );

  StaticBitLengthDescriptor: TStaticTreeDescriptor = (
    StaticTree: nil;
    ExtraBits: @ExtraBitLengthBits;
    ExtraBase: 0;
    Elements: BL_CODES;
    MaxLength: MAX_BL_BITS
  );

  SMALLEST = 1; // index within the heap array of least frequent node in the Huffman tree

//----------------------------------------------------------------------------------------------------------------------

procedure SendBits(var S: TDeflateState; Value: Word; Length: Integer);

// Value contains what is to be sent
// Length is the number of bits to send

begin
  // If there's not enough room in BitsBuffer use (valid) bits from BitsBuffer and
  // (16 - ValidBits) bits from Value, leaving (width - (16 - ValidBits)) unused bits in Value.
  {$ifopt Q+} {$Q-} {$define OverflowCheck} {$endif}
  {$ifopt R+} {$R-} {$define RangeCheck} {$endif}
  if (S.ValidBits > Integer(BufferSize) - Length) then
  begin
    S.BitsBuffer := S.BitsBuffer or (Value shl S.ValidBits);
    S.PendingBuffer[S.Pending] := S.BitsBuffer and $FF;
    Inc(S.Pending);
    S.PendingBuffer[S.Pending] := S.BitsBuffer shr 8;
    Inc(S.Pending);

    S.BitsBuffer := Value shr (BufferSize - S.ValidBits);
    Inc(S.ValidBits, Length - BufferSize);
  end
  else
  begin
    S.BitsBuffer := S.BitsBuffer or (Value shl S.ValidBits);
    Inc(S.ValidBits, Length);
  end;
  {$ifdef OverflowCheck} {$Q+} {$undef OverflowCheck} {$endif}
  {$ifdef RangeCheck} {$R+} {$undef RangeCheck} {$endif}
end;

//----------------------------------------------------------------------------------------------------------------------

function BitReverse(Code: Word; Len: Integer): Word;

// Reverses the first Len bits of Code, using straightforward code (a faster
// imMethod would use a table)

begin
  Result := 0;
  repeat
    Result := Result or (Code and 1);
    Code := Code shr 1;
    Result := Result shl 1;
    Dec(Len);
  until Len <= 0;
  Result := Result shr 1;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure GenerateCodes(Tree: PTree; MaxCode: Integer; const BitLengthCounts: array of Word);

// Generates the codes for a given tree and bit counts (which need not be optimal).
// The array BitLengthCounts contains the bit length statistics for the given tree and the field Len is set for all
// Tree elements. MaxCode is the largest code with non zero frequency and BitLengthCounts are the number of codes at
// each bit length.
// On exit the field code is set for all tree elements of non zero code length.

var
  NextCode: array[0..MAX_BITS] of Word; // next code value for each bit length
  Code: Word;      // running code value
  Bits: Integer;   // bit Index
  N: Integer;      // code Index
  Len: Integer;

begin
  Code := 0;

  // The distribution counts are first used to generate the code values without bit reversal.
  for Bits := 1 to MAX_BITS do
  begin
    Code := (Code + BitLengthCounts[Bits - 1]) shl 1;
    NextCode[Bits] := Code;
  end;

  // Check that the bit counts in BitLengthCounts are consistent. The last code must be all ones.
  for N := 0 to MaxCode do
  begin
    Len := Tree[N].dl.Len;
    if Len = 0 then Continue;
    Tree[N].fc.Code := BitReverse(NextCode[Len], Len);
    Inc(NextCode[Len]);
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure InitializeBlock(var S: TDeflateState);

var
  N: Integer;  

begin
  // initialize the trees 
  for N := 0 to L_CODES - 1 do S.LiteralTree[N].fc.Frequency := 0;
  for N := 0 to D_CODES - 1 do S.DistanceTree[N].fc.Frequency := 0;
  for N := 0 to BL_CODES - 1 do S.BitLengthTree[N].fc.Frequency := 0;

  S.LiteralTree[END_BLOCK].fc.Frequency := 1;
  S.StaticLength := 0;
  S.OptimalLength := 0;
  S.Matches := 0;
  S.LastLiteral := 0;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TreeInit(var S: TDeflateState);

// initializes the tree data structures for a new zlib stream

begin
  S.CompressedLength := 0;

  S.LiteralDescriptor.DynamicTree := @S.LiteralTree;
  S.LiteralDescriptor.StaticDescriptor := @StaticLiteralDescriptor;

  S.DistanceDescriptor.DynamicTree := @S.DistanceTree;
  S.DistanceDescriptor.StaticDescriptor := @StaticDistanceDescriptor;

  S.BitLengthDescriptor.DynamicTree := @S.BitLengthTree;
  S.BitLengthDescriptor.StaticDescriptor := @StaticBitLengthDescriptor;

  S.BitsBuffer := 0;
  S.ValidBits := 0;
  S.LastEOBLength := 8; // enough Lookahead for Inflate 
  // initialize the first block of the first file 
  InitializeBlock(S);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure RestoreHeap(var S: TDeflateState; const Tree: TTree; K: Integer);

// Restores the heap property by moving down tree starting at node K,
// exchanging a Node with the smallest of its two sons if necessary, stopping
// when the heap property is re-established (each father smaller than its two sons).

var
  V, J: Integer;

begin
  V := S.Heap[K];
  J := K shl 1;  // left son of K
  while J <= S.HeapLength do
  begin
    // set J to the smallest of the two sons:
    if (J < S.HeapLength) and
       ((Tree[S.Heap[J + 1]].fc.Frequency < Tree[S.Heap[J]].fc.Frequency) or
        ((Tree[S.Heap[J + 1]].fc.Frequency = Tree[S.Heap[J]].fc.Frequency) and
         (S.Depth[S.Heap[J + 1]] <= S.Depth[S.Heap[J]]))) then Inc(J);

    // exit if V is smaller than both sons