kpdflt.pas

天涯進銷存系統

      if (prev_length >= good_match) then
         chain_length := chain_length shr 2;

      {$IFDEF ASSERTS}
      Assert(strstart <= window_size - MIN_LOOKAHEAD, 'Insufficient lookahead');
      {$ENDIF}

      repeat
         {$IFDEF ASSERTS}
         Assert(cur_match < strstart, 'No Future');
         {$ENDIF}
         match := PWord(@window^[cur_match]);
         if (PWord(LongInt(match) + Result - 1)^ <> scan_end^) or
            (match^ <> scan_start^) then
         begin
            cur_match := prev^[cur_match and WMASK];
            if (cur_match > limit) then
               Dec(chain_length);
            continue;
         end;

         Inc(PByte(scan));
         Inc(PByte(match));

         repeat
            Inc(scan); Inc(match);
            if (scan^ <> match^) then break;
            Inc(scan); Inc(match);
            if (scan^ <> match^) then break;
            Inc(scan); Inc(match);
            if (scan^ <> match^) then break;
            Inc(scan); Inc(match);
            if (scan^ <> match^) then break;
         until (LongInt(scan) >= LongInt(strend));

         {$IFDEF ASSERTS}
         Assert(LongInt(scan) <= LongInt(@window^[window_size - 1]), 'Wild Scan');
         {$ENDIF}

         if (PByte(scan)^ = PByte(match)^) then
            Inc(PByte(scan));

         len := (MAX_MATCH - 1) - Word(LongInt(strend) - LongInt(scan));
         scan := PWord(LongInt(strend) - (MAX_MATCH - 1));

         if (len > Result) then
         begin
            match_start := cur_match;
            Result := len;
            if (Result >= nice_match) then
               break;
            scan_end := PWord(LongInt(scan) + Result - 1);
         end;

         cur_match := prev^[cur_match and WMASK];
         if (cur_match > limit) then
            Dec(chain_length);

      until (cur_match <= limit) or (chain_length = 0);

   end;

   {$IFOPT D+}
   {$IFDEF KPDEBUG}
   {$IFNDEF WIN16}

   procedure check_match(start, match: IPos; mlength: Integer);
   begin
      if (not BlockCompare(window^[match], window^[start], mlength)) then
         raise EInvalidMatch.CreateFmt('Start: %d, Match: %d, Length: %d', [Start, Match,
            mlength]);
   end;
   {$ENDIF}
   {$ENDIF}
   {$ENDIF}

   function FLUSH_BLOCK(eofblock: Integer): LongInt;
   begin
      {flush_the_block is in trees.pas}
      if (block_start >= 0) then
         Result := flush_the_block(@window^[block_start], strstart - block_start,
            eofblock)
      else
         Result := flush_the_block(nil, strstart - block_start, eofblock);
   end;

   procedure init_desc;
   begin
      with l_desc do
      begin
         dyn_tree := ct_dataArrayPtr(@dyn_ltree);       { added typecast 5/18/98  2.13 }
         static_tree := ct_dataArrayPtr(@static_ltree); { added typecast 5/18/98  2.13 }
         extra_bits := IntegerArrayPtr(@extra_lbits);   { added typecast 5/18/98  2.13 }
         extra_base := LITERALS + 1;
         elems := L_CODES;
         max_length := MAX_ZBITS;
         max_code := 0;
      end;
      with d_desc do
      begin
         dyn_tree := ct_dataArrayPtr(@dyn_dtree);       { added typecast 5/18/98  2.13 }
         static_tree := ct_dataArrayPtr(@static_dtree); { added typecast 5/18/98  2.13 }
         extra_bits := IntegerArrayPtr(@extra_dbits);   { added typecast 5/18/98  2.13 }
         extra_base := 0;
         elems := D_CODES;
         max_length := MAX_ZBITS;
         max_code := 0;
      end;
      with bl_desc do
      begin
         dyn_tree := ct_dataArrayPtr(@bl_tree);         { added typecast 5/18/98  2.13 }
         static_tree := nil;
         extra_bits := IntegerArrayPtr(@extra_blbits);  { added typecast 5/18/98  2.13 }
         extra_base := 0;
         elems := BL_CODES;
         max_length := MAX_BL_BITS;
         max_code := 0;
      end;
   end;

   function deflate_fast: LongInt;
   var
      hash_head               : IPos;
      flush                   : Boolean;
      match_length            : usigned;
   begin
      hash_head := 0;
      match_length := 0;
      prev_length := MIN_MATCH - 1;

      while (lookahead <> 0) do
      begin
         if (lookahead >= MIN_MATCH) then
            {INSERT_STRING( strstart, hash_head );}
         begin
            ins_h := ((ins_h shl H_SHIFT) xor window^[strstart + MIN_MATCH - 1]) and
               HASH_MASK;
            prev^[strstart and WMASK] := head^[ins_h];
            hash_head := head^[ins_h];
            head^[ins_h] := strstart;
         end;
         if (hash_head <> 0) and (strstart - hash_head <= MAX_DIST) then
         begin
            match_length := longest_match(hash_head);
            if (match_length > lookahead) then
               match_length := lookahead;
         end; { If (hash_head <> 0) and (strstart - hash_head <= MAX_DIST) }
         if (match_length >= MIN_MATCH) then
         begin
            {$IFOPT D+}
            {$IFDEF KPDEBUG}
            {$IFNDEF WIN16}
            check_match(strstart, match_start, match_length);
            {$ENDIF}
            {$ENDIF}
            {$ENDIF}
            {ct_tally is in trees}
            flush := ct_tally(strstart - match_start, match_length - MIN_MATCH);
            Dec(lookahead, match_length);
            if (match_length <= max_lazy_match) then
            begin
               Dec(match_length);
               repeat
                  Inc(strstart);
                  {INSERT_STRING( strstart, hash_head );}

                  ins_h := ((ins_h shl H_SHIFT) xor window^[strstart + MIN_MATCH - 1])
                     and
                     HASH_MASK;
                  prev^[strstart and WMASK] := head^[ins_h];
                  {hash_head := head^[ins_h]; }
                  head^[ins_h] := strstart;

                  Dec(match_length);
               until (match_length = 0);
               Inc(strstart);
            end { If (match_length <= max_insert_length) }
            else
            begin
               Inc(strstart, match_length);
               match_length := 0;
               ins_h := window^[strstart];
               {UPDATE_HASH( ins_h, window^[strstart+1] );}
               ins_h := ((ins_h shl H_SHIFT) xor window^[strstart + 1]) and HASH_MASK;
            end; { If (match_length <= max_insert_length) Else }
         end                                            { If (match_length >= MIN_MATCH) }
         else
         begin
            flush := ct_tally(0, window^[strstart]);
            Dec(lookahead);
            Inc(strstart);
         end;                                           { If (match_length >= MIN_MATCH) Else }
         if (flush) then
         begin
            FLUSH_BLOCK(0);
            block_start := strstart;
         end;
         if (lookahead < MIN_LOOKAHEAD) then
            fill_window;
      end;                                              { while (lookahead <> 0) }

      Result := FLUSH_BLOCK(1);
   end;                                                 { function deflate_fast }

   {=========================  Main Deflate Procedure  =================================}

var
   hash_head                  : IPos;
   prev_match                 : IPos;
   flush                      : Boolean;
   match_available            : Integer;
   match_length               : usigned;
   max_Insert                 : LongInt;
begin
   window_size := 0;
   init_desc;
   bi_init;
   ct_init;
   lm_init;
   match_available := 0;
   match_length := MIN_MATCH - 1;
   hash_head := 0;
   if (FPackLevel <= 3) then
   begin
      Result := deflate_fast;
      exit;
   end;                                                 { If (FPackLevel <= 3) }

   while (lookahead <> 0) do
   begin
      if (lookahead >= MIN_MATCH) then
         {INSERT_STRING( strstart, hash_head );}
      begin
         ins_h := ((ins_h shl H_SHIFT) xor window^[strstart + MIN_MATCH - 1]) and HASH_MASK;
         prev^[strstart and WMASK] := head^[ins_h];
         hash_head := head^[ins_h];
         head^[ins_h] := strstart;
      end;
      prev_length := match_length;
      prev_match := match_start;
      match_length := MIN_MATCH - 1;

      if (hash_head <> 0) and (prev_length < max_lazy_match) and
         (strstart - hash_head <= MAX_DIST) then
      begin
         match_length := longest_match(hash_head);
         if (match_length > lookahead) then
            match_length := lookahead;
         if (match_length = MIN_MATCH) and (strstart - match_start > TOO_FAR) then
            match_length := MIN_MATCH - 1;
      end; { If (hash_head <> 0) and (prev_length < max_lazy_match) and
      (strstart - hash_head <= MAX_DIST) }
      if (prev_length >= MIN_MATCH) and (match_length <= prev_length) then
      begin
          {max_Insert := strstart + lookahead - MIN_MATCH;}
         {$IFDEF KPDEBUG}
         {$IFNDEF WIN16}
         check_match(strstart - 1, prev_match, prev_length);
         {$ENDIF}
         {$ENDIF}
         {max_Insert := strstart + lookahead - MIN_MATCH;}
         flush := ct_tally(strstart - 1 - prev_match, prev_length - MIN_MATCH);
         Dec(lookahead, prev_length - 1);
         Dec(prev_length, 2);
         repeat
            Inc(strstart);
            {if (strstart >= MAX_MATCH) then }
               {INSERT_STRING( strstart, hash_head );} 
            {begin }
               ins_h := ((ins_h shl H_SHIFT) xor window^[strstart + MIN_MATCH - 1]) and
                  HASH_MASK;
               prev^[strstart and WMASK] := head^[ins_h];
               {hash_head := head^[ins_h];}
               head^[ins_h] := strstart;
            {end; }
            Dec(prev_length);
         until (prev_length = 0);
         match_available := 0;
         match_length := MIN_MATCH - 1;
         Inc(strstart);
         if (flush) then
         begin
            FLUSH_BLOCK(0);
            block_start := strstart;
         end;                                           { If (flush <> 0) }
      end { If (prev_length >= MIN_MATCH) and (match_length <= prev_length) }
      else
         if (match_available <> 0) then
         begin
            if (ct_tally(0, window^[strstart - 1])) then
            begin
               FLUSH_BLOCK(0);
               block_start := strstart;
            end;                                        { If (ct_tally( 0, window[strstart-1]) }
            Inc(strstart);
            Dec(lookahead);
         end { If (prev_length >= MIN_MATCH) and (match_length <= prev_length) }
         else
         begin
            match_available := 1;
            Inc(strstart);
            Dec(lookahead);
         end; { If (prev_length >= MIN_MATCH) and (match_length <= prev_length) Else }

      {$IFDEF ASSERTS}
      Assert((strstart <= isize) and (lookahead <= isize), 'a bit too far - deflate');
      {$ENDIF}

      if (lookahead < MIN_LOOKAHEAD) then
         fill_window;
   end;                                                 { While (lookahead <> 0) }
   if (match_available <> 0) then
      {flush :=} ct_tally(0, window^[strstart - 1]);
   Result := FLUSH_BLOCK(1);
end;