abdfinw.pas

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

  MaxCh : char;
  {$ENDIF}
begin
  {calculate the hash index for the current position; using the
   Rabin-Karp algorithm this is equal to the previous index less the
   effect of the character just lost plus the effect of the character
   just gained}
  CurPos := FCurrent;
  FHashIndex :=
     ((FHashIndex shl c_HashShift) xor longint(CurPos[2])) and
     c_HashMask;

  {get the head of the hash chain: this is the position in the sliding
   window of the previous 3-character string with this hash value}
  PrevStrPos := FHashHeads^[FHashIndex];

  {set the head of the hash chain equal to our current position}
  FHashHeads^[FHashIndex] := CurPos;

  {update the chain itself: set the entry for this position equal to
   the previous string position}
  FHashChains^[longint(CurPos) and FWinMask] := PrevStrPos;

  {calculate the maximum match we could do at this position}
  MaxMatch := (FLookAheadEnd - CurPos);
  if (MaxMatch > FMaxMatchLen) then
    MaxMatch := FMaxMatchLen;
  if (aAmpleLength > MaxMatch) then
    aAmpleLength := MaxMatch;

  {calculate the current match length}
  if (aPrevMatch.maLen = 0) then
    MaxLen := 2
  else begin
    if (MaxMatch < aPrevMatch.maLen) then begin
      Result := false;
      aMatch.maLen := 0;
      aMatch.maLit := CurPos^;
      Exit;
    end;
    MaxLen := aPrevMatch.maLen;
  end;

  {get the bytes at the current position and at the end of the maximum
   match we have to better}
  {$IFDEF UseGreedyAsm}
  CurWord := PWord(CurPos)^;
  MaxWord := PWord(CurPos + pred(MaxLen))^;
  {$ENDIF}
  {$IFDEF UseGreedyPascal}
  CurCh := CurPos^;
  MaxCh := (CurPos + pred(MaxLen))^;
  {$ENDIF}

  {set the chain length to search based on the current maximum match
   (basically: if we've already satisfied the ample length
   requirement, don't search as far)}
  if (MaxLen >= aAmpleLength) then
    ChainLen := FChainLen div 4
  else
    ChainLen := FChainLen;

  {get ready for the loop}
  {$IFDEF DefeatWarnings}
  MaxDist := 0;
  {$ENDIF}

  {$IFDEF UseGreedyAsm} { slip into assembler for speed...}
  asm
    push ebx                 { save those registers we should}
    push esi
    push edi

    mov ebx, Self            { ebx will store the Self pointer}
    mov edi, PrevStrPos      { edi => previous string}
    mov esi, CurPos          { esi => current string}

  @@TestThisPosition:
                             { check previous string is in range}
    or edi, edi
    je @@Exit
    cmp edi, [ebx].TAbDfInputWindow.FStart
    jb @@Exit
    cmp edi, CurPos
    jae @@Exit

    mov ax, [edi]            { check previous string starts with same}
    cmp CurWord, ax          {   two bytes as current}
    jne @@GetNextPosition    { ..nope, they don't match}

    mov edx, edi             { check previous string ends with same}
    add edi, MaxLen          {   two bytes as current (by "ends" we}
    dec edi                  {   mean the last two bytes at the}
    mov ax, [edi]            {   current match length)}
    cmp MaxWord, ax
    mov edi, edx
    jne @@GetNextPosition    { ..nope, they don't match}

    push edi                 { compare the previous string with the}
    push esi                 {   current string}
    mov eax, MaxMatch
    add edi, 2               { (we've already checked that the first}
    sub eax, 2               { two characters are the same)}
    add esi, 2
    mov ecx, eax

  @@CmpQuads:
    cmp ecx, 4
    jb @@CmpSingles

    mov edx, [esi]
    cmp edx, [edi]
    jne @@CmpSingles

    add esi, 4
    add edi, 4
    sub ecx, 4
    jnz @@CmpQuads

    jmp @@MatchCheck

  @@CmpSingles:
    or ecx, ecx
    jb @@MatchCheck

    mov dl, [esi]
    cmp dl, [edi]
    jne @@MatchCheck

    inc esi
    inc edi
    dec ecx
    jnz @@CmpSingles

  @@MatchCheck:
    sub eax, ecx
    add eax, 2
    pop esi
    pop edi

    cmp eax, MaxLen          { have we found a longer match?}
    jbe @@GetNextPosition    { ..no}
    mov MaxLen, eax          { ..yes, so save it}

    mov eax, esi             { calculate the dist for this new match}
    sub eax, edi
    mov MaxDist, eax

    cmp eax, aAmpleLength    { if this match is ample enough, exit}
    jae @@Exit

    mov eax, esi             { calculate the two bytes at the end of}
    add eax, MaxLen          {   this new match}
    dec eax
    mov ax, [eax]
    mov MaxWord, ax

  @@GetNextPosition:
    mov eax, ChainLen        { we've visited one more link on the}
    dec eax                  {   chain, if that's the last one we}
    je @@Exit                {   should visit, exit}
    mov ChainLen, eax

                             { advance along the chain}
    mov edx, [ebx].TAbDfInputWindow.FHashChains
    mov eax, [ebx].TAbDfInputWindow.FWinMask
    and edi, eax
    shl edi, 2
    mov edi, [edx+edi]
    jmp @@TestThisPosition

  @@Exit:
    pop edi
    pop esi
    pop ebx
  end;
  {$ENDIF}

  {$IFDEF UseGreedyPascal}
  {for all possible hash nodes in the chain...}
  while (FStart <= PrevStrPos) and (PrevStrPos < CurPos) do begin

    {if the initial and maximal characters match...}
    if (PrevStrPos[0] = CurCh) and
       (PrevStrPos[pred(MaxLen)] = MaxCh) then begin

      {compare more characters}
      Len := 1;
      CurrentCh := CurPos + 1;
      MatchStr := PrevStrPos + 1;

      {compare away, but don't go above the maximum length}
      while (Len < MaxMatch) and (MatchStr^ = CurrentCh^) do begin
        inc(CurrentCh);
        inc(MatchStr);
        inc(Len);
      end;

      {have we reached another maximum for the length?}
      if (Len > MaxLen) then begin
        MaxLen := Len;
        {calculate the distance}
        MaxDist := CurPos - PrevStrPos;
        MaxCh := CurPos[pred(MaxLen)];

        {is the new best length ample enough?}
        if MaxLen >= aAmpleLength then
          Break;
      end;
    end;

    {have we reached the end of this chain?}
    dec(ChainLen);
    if (ChainLen = 0) then
      Break;

    {otherwise move onto the next position}
    PrevStrPos := FHashChains^[longint(PrevStrPos) and FWinMask];
  end;
  {$ENDIF}

  {based on the results of our investigation, return the match values}
  if (MaxLen < 3) or (MaxLen <= aPrevMatch.maLen) then begin
    Result := false;
    aMatch.maLen := 0;
    aMatch.maLit := CurPos^;
  end
  else begin
    Result := true;
    aMatch.maLen := MaxLen;
    aMatch.maDist := MaxDist;
    aMatch.maLit := CurPos^; { just in case...}
  end;
end;
{--------}
function TAbDfInputWindow.GetNextChar : AnsiChar;
begin
  Result := FCurrent^;
  inc(FCurrent);
end;
{--------}
function TAbDfInputWindow.GetNextKeyLength : integer;
begin
  Result := FLookAheadEnd - FCurrent;
  if (Result > 3) then
    Result := 3;
end;
{--------}
function TAbDfInputWindow.iwGetChecksum : longint;
begin
  {the CRC32 checksum algorithm requires a post-conditioning step
   after being calculated (the result is NOTted), whereas Adler32 does
   not}
  if FUseCRC32 then
    Result := not FChecksum
  else
    Result := FChecksum;
end;
{--------}
procedure TAbDfInputWindow.iwReadFromStream;
var
  BytesRead   : longint;
  BytesToRead : longint;
begin
  {read some more data into the look ahead zone}
  BytesToRead := FBufferEnd - FLookAheadEnd;
  BytesRead := FStream.Read(FLookAheadEnd^, BytesToRead);

  {if nothing was read, we reached the end of the stream; hence
   there's no more need to slide the window since we have all the
   data}
  if (BytesRead = 0) then
    FMustSlide := false

  {otherwise something was actually read...}
  else begin
    {update the checksum}
    if FUseCRC32 then
      AbUpdateCRCBuffer(FChecksum, FLookAheadEnd^, BytesRead)
    else
      AbUpdateAdlerBuffer(FChecksum, FLookAheadEnd^, BytesRead);

    {reposition the pointer for the end of the lookahead area}
    inc(FLookAheadEnd, BytesRead);
  end;
end;
{--------}
procedure TAbDfInputWindow.iwSetCapacity(aValue : longint);
var
  ActualSize : integer;
begin
  {calculate the actual size; this will be the value passed in, plus
   the correct look ahead size, plus 16KB}
  ActualSize := aValue + (16 * 1024);
  if FUseDeflate64 then begin
    inc(ActualSize, dfc_MaxMatchLen64);
    FMaxMatchLen := dfc_MaxMatchLen64;
  end
  else begin
    inc(ActualSize, dfc_MaxMatchLen);
    FMaxMatchLen := dfc_MaxMatchLen;
  end;

  {get the new buffer}
  GetMem(FBuffer, ActualSize);

  {set the other buffer pointers}
  FStart := FBuffer;
  FCurrent := FBuffer;
  FLookAheadEnd := FBuffer;
  FBufferEnd := FBuffer + ActualSize;
  FSlidePoint := FBuffer + (16 * 1024);
end;
{--------}
procedure TAbDfInputWindow.iwSlide;
type
  PLongint = ^longint;
var
  i : integer;
  ByteCount : integer;
  Buffer    : longint;
  ListItem  : PLongint;
begin
  {move current valid data back to the start of the buffer}
  ByteCount := FLookAheadEnd - FStart;
  Move(FStart^, FBuffer^, ByteCount);

  {reset the various pointers}
  ByteCount := FStart - FBuffer;
  FStart := FBuffer;
  dec(FCurrent, ByteCount);
  dec(FLookAheadEnd, ByteCount);

  {patch up the hash table: the head pointers}
  Buffer := longint(FBuffer);
  ListItem := PLongint(@FHashHeads^[0]);
  for i := 0 to pred(c_HashCount) do begin
    dec(ListItem^, ByteCount);
    if (ListItem^ < Buffer) then
      ListItem^ := 0;
    inc(PAnsiChar(ListItem), sizeof(pointer));
  end;

  {..the chain pointers}
  ListItem  := PLongint(@FHashChains^[0]);
  for i := 0 to pred(FWinSize) do begin
    dec(ListItem^, ByteCount);
    if (ListItem^ < Buffer) then
      ListItem^ := 0;
    inc(PAnsiChar(ListItem), sizeof(pointer));
  end;

  {now read some more data from the stream}
  iwReadFromStream;
end;
{--------}
function TAbDfInputWindow.Position : longint;
begin
  Result := (FCurrent - FStart) + FStartOffset;
end;
{--------}
procedure TAbDfInputWindow.ReadBuffer(var aBuffer; aCount  : longint;
                                                   aOffset : longint);
var
  CurPos : longint;
begin
  CurPos := FStream.Seek(0, soFromCurrent);
  FStream.Seek(aOffSet, soFromBeginning);
  FStream.ReadBuffer(aBuffer, aCount);
  FStream.Seek(CurPos, soFromBeginning);
end;
{====================================================================}

end.