trees.pas

zlib pascal语言源码

      all ones)  }

    gen_codes(tree_ptr(@static_ltree), L_CODES+1, bl_count);

    { The static distance tree is trivial: }
    for n := 0 to D_CODES-1 do
    begin
      static_dtree[n].dl.Len := 5;
      static_dtree[n].fc.Code := bi_reverse(unsigned(n), 5);
    end;
    static_init_done := TRUE;

    gen_trees_header;  { save to include file }
{$else}
begin
{$endif} { GEN_TREES_H) }
end;

{ ===========================================================================
  Initialize a new block. }
{local}

procedure init_block(var s : deflate_state);
var
  n : int; { iterates over tree elements }
begin
  { Initialize the trees. }
  for n := 0 to L_CODES-1 do
    s.dyn_ltree[n].fc.Freq := 0;
  for n := 0 to D_CODES-1 do
    s.dyn_dtree[n].fc.Freq := 0;
  for n := 0 to BL_CODES-1 do
    s.bl_tree[n].fc.Freq := 0;

  s.dyn_ltree[END_BLOCK].fc.Freq := 1;
  s.static_len := Long(0);
  s.opt_len := Long(0);
  s.matches := 0;
  s.last_lit := 0;
end;

const
  SMALLEST = 1;
{ Index within the heap array of least frequent node in the Huffman tree }

{ ===========================================================================
  Initialize the tree data structures for a new zlib stream. }
procedure _tr_init(var s : deflate_state);
begin
  tr_static_init;

  s.compressed_len := Long(0);

  s.l_desc.dyn_tree := tree_ptr(@s.dyn_ltree);
  s.l_desc.stat_desc := @static_l_desc;

  s.d_desc.dyn_tree := tree_ptr(@s.dyn_dtree);
  s.d_desc.stat_desc := @static_d_desc;

  s.bl_desc.dyn_tree := tree_ptr(@s.bl_tree);
  s.bl_desc.stat_desc := @static_bl_desc;

  s.bi_buf := 0;
  s.bi_valid := 0;
  s.last_eob_len := 8; { enough lookahead for inflate }
{$ifdef DEBUG}
  s.bits_sent := Long(0);
{$endif}

  { Initialize the first block of the first file: }
  init_block(s);
end;

{ ===========================================================================
  Remove the smallest element from the heap and recreate the heap with
  one less element. Updates heap and heap_len.

macro pqremove(s, tree, top)
begin
    top := s.heap[SMALLEST];
    s.heap[SMALLEST] := s.heap[s.heap_len];
    Dec(s.heap_len);
    pqdownheap(s, tree, SMALLEST);
end
}

{ ===========================================================================
  Compares to subtrees, using the tree depth as tie breaker when
  the subtrees have equal frequency. This minimizes the worst case length.

macro smaller(tree, n, m, depth)
   ( (tree[n].Freq < tree[m].Freq) or
     ((tree[n].Freq = tree[m].Freq) and (depth[n] <= depth[m])) )
}

{ ===========================================================================
  Restore the heap property by moving down the 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). }
{local}

procedure pqdownheap(var s : deflate_state;
                     var tree : tree_type;   { the tree to restore }
                     k : int);          { node to move down }
var
  v : int;
  j : int;
begin
  v := s.heap[k];
  j := k shl 1;  { left son of k }
  while (j <= s.heap_len) do
  begin
    { Set j to the smallest of the two sons: }
    if (j < s.heap_len) and
       {smaller(tree, s.heap[j+1], s.heap[j], s.depth)}
      ( (tree[s.heap[j+1]].fc.Freq < tree[s.heap[j]].fc.Freq) or
        ((tree[s.heap[j+1]].fc.Freq = tree[s.heap[j]].fc.Freq) and
         (s.depth[s.heap[j+1]] <= s.depth[s.heap[j]])) ) then
    begin
      Inc(j);
    end;
    { Exit if v is smaller than both sons }
    if {(smaller(tree, v, s.heap[j], s.depth))}
     ( (tree[v].fc.Freq < tree[s.heap[j]].fc.Freq) or
       ((tree[v].fc.Freq = tree[s.heap[j]].fc.Freq) and
        (s.depth[v] <= s.depth[s.heap[j]])) ) then
      break;
    { Exchange v with the smallest son }
    s.heap[k] := s.heap[j];
    k := j;

    { And continue down the tree, setting j to the left son of k }
    j := j shl 1;
  end;
  s.heap[k] := v;
end;

{ ===========================================================================
  Compute the optimal bit lengths for a tree and update the total bit length
  for the current block.
  IN assertion: the fields freq and dad are set, heap[heap_max] and
     above are the tree nodes sorted by increasing frequency.
  OUT assertions: the field len is set to the optimal bit length, the
      array bl_count contains the frequencies for each bit length.
      The length opt_len is updated; static_len is also updated if stree is
      not null. }

{local}
procedure gen_bitlen(var s : deflate_state;
                     var desc : tree_desc);   { the tree descriptor }
var
  tree : tree_ptr;
  max_code : int;
  stree : tree_ptr; {const}
  extra : pzIntfArray; {const}
  base : int;
  max_length : int;
  h : int;              { heap index }
  n, m : int;           { iterate over the tree elements }
  bits : int;           { bit length }
  xbits : int;          { extra bits }
  f : ush;              { frequency }
  overflow : int;   { number of elements with bit length too large }
begin
  tree := desc.dyn_tree;
  max_code := desc.max_code;
  stree := desc.stat_desc^.static_tree;
  extra := desc.stat_desc^.extra_bits;
  base := desc.stat_desc^.extra_base;
  max_length := desc.stat_desc^.max_length;
  overflow := 0;

  for bits := 0 to MAX_BITS do
    s.bl_count[bits] := 0;

  { In a first pass, compute the optimal bit lengths (which may
    overflow in the case of the bit length tree). }

  tree^[s.heap[s.heap_max]].dl.Len := 0; { root of the heap }

  for h := s.heap_max+1 to HEAP_SIZE-1 do
  begin
    n := s.heap[h];
    bits := tree^[tree^[n].dl.Dad].dl.Len + 1;
    if (bits > max_length) then
    begin
      bits := max_length;
      Inc(overflow);
    end;
    tree^[n].dl.Len := ush(bits);
    { We overwrite tree[n].dl.Dad which is no longer needed }

    if (n > max_code) then
      continue; { not a leaf node }

    Inc(s.bl_count[bits]);
    xbits := 0;
    if (n >= base) then
      xbits := extra^[n-base];
    f := tree^[n].fc.Freq;
    Inc(s.opt_len, ulg(f) * (bits + xbits));
    if (stree <> NIL) then
      Inc(s.static_len, ulg(f) * (stree^[n].dl.Len + xbits));
  end;
  if (overflow = 0) then
    exit;
  {$ifdef DEBUG}
  Tracev(^M'bit length overflow');
  {$endif}
  { This happens for example on obj2 and pic of the Calgary corpus }

  { Find the first bit length which could increase: }
  repeat
    bits := max_length-1;
    while (s.bl_count[bits] = 0) do
      Dec(bits);
    Dec(s.bl_count[bits]);      { move one leaf down the tree }
    Inc(s.bl_count[bits+1], 2); { move one overflow item as its brother }
    Dec(s.bl_count[max_length]);
    { The brother of the overflow item also moves one step up,
      but this does not affect bl_count[max_length] }

    Dec(overflow, 2);
  until (overflow <= 0);

  { Now recompute all bit lengths, scanning in increasing frequency.
    h is still equal to HEAP_SIZE. (It is simpler to reconstruct all
    lengths instead of fixing only the wrong ones. This idea is taken
    from 'ar' written by Haruhiko Okumura.) }
  h := HEAP_SIZE;  { Delphi3: compiler warning w/o this }
  for bits := max_length downto 1 do
  begin
    n := s.bl_count[bits];
    while (n <> 0) do
    begin
      Dec(h);
      m := s.heap[h];
      if (m > max_code) then
        continue;
      if (tree^[m].dl.Len <> unsigned(bits)) then
      begin
        {$ifdef DEBUG}
        Trace('code '+IntToStr(m)+' bits '+IntToStr(tree^[m].dl.Len)
              +'.'+IntToStr(bits));
        {$ENDIF}
        Inc(s.opt_len, (long(bits) - long(tree^[m].dl.Len))
                        * long(tree^[m].fc.Freq) );
        tree^[m].dl.Len := ush(bits);
      end;
      Dec(n);
    end;
  end;
end;

{ ===========================================================================
  Construct one Huffman tree and assigns the code bit strings and lengths.
  Update the total bit length for the current block.
  IN assertion: the field freq is set for all tree elements.
  OUT assertions: the fields len and code are set to the optimal bit length
      and corresponding code. The length opt_len is updated; static_len is
      also updated if stree is not null. The field max_code is set. }

{local}
procedure build_tree(var s : deflate_state;
                     var desc : tree_desc); { the tree descriptor }

var
  tree : tree_ptr;
  stree : tree_ptr; {const}
  elems : int;
  n, m : int;          { iterate over heap elements }
  max_code : int;      { largest code with non zero frequency }
  node : int;          { new node being created }
begin
  tree := desc.dyn_tree;
  stree := desc.stat_desc^.static_tree;
  elems := desc.stat_desc^.elems;
  max_code := -1;

  { Construct the initial heap, with least frequent element in
    heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1].
    heap[0] is not used. }
  s.heap_len := 0;
  s.heap_max := HEAP_SIZE;

  for n := 0 to elems-1 do
  begin
    if (tree^[n].fc.Freq <> 0) then
    begin
      max_code := n;
      Inc(s.heap_len);
      s.heap[s.heap_len] := n;
      s.depth[n] := 0;
    end
    else
    begin
      tree^[n].dl.Len := 0;
    end;
  end;

  { The pkzip format requires that at least one distance code exists,
    and that at least one bit should be sent even if there is only one
    possible code. So to avoid special checks later on we force at least
    two codes of non zero frequency. }

  while (s.heap_len < 2) do
  begin
    Inc(s.heap_len);
    if (max_code < 2) then
    begin
      Inc(max_code);
      s.heap[s.heap_len] := max_code;
      node := max_code;
    end
    else
    begin
      s.heap[s.heap_len] := 0;
      node := 0;
    end;
    tree^[node].fc.Freq := 1;
    s.depth[node] := 0;
    Dec(s.opt_len);
    if (stree <> NIL) then
      Dec(s.static_len, stree^[node].dl.Len);
    { node is 0 or 1 so it does not have extra bits }
  end;
  desc.max_code := max_code;

  { The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree,
    establish sub-heaps of increasing lengths: }

  for n := s.heap_len div 2 downto 1 do
    pqdownheap(s, tree^, n);

  { Construct the Huffman tree by repeatedly combining the least two
    frequent nodes. }

  node := elems;              { next internal node of the tree }
  repeat
    {pqremove(s, tree, n);}  { n := node of least frequency }
    n := s.heap[SMALLEST];
    s.heap[SMALLEST] := s.heap[s.heap_len];
    Dec(s.heap_len);
    pqdownheap(s, tree^, SMALLEST);

    m := s.heap[SMALLEST]; { m := node of next least frequency }

    Dec(s.heap_max);
    s.heap[s.heap_max] := n; { keep the nodes sorted by frequency }
    Dec(s.heap_max);
    s.heap[s.heap_max] := m;

    { Create a new node father of n and m }
    tree^[node].fc.Freq := tree^[n].fc.Freq + tree^[m].fc.Freq;
    { maximum }
    if (s.depth[n] >= s.depth[m]) then
      s.depth[node] := uch (s.depth[n] + 1)
    else
      s.depth[node] := uch (s.depth[m] + 1);

    tree^[m].dl.Dad := ush(node);
    tree^[n].dl.Dad := ush(node);
{$ifdef DUMP_BL_TREE}
    if (tree = tree_ptr(@s.bl_tree)) then