[Back to ARCHIVES SWAG index] [Back to Main SWAG index] [Original]

    {$R-} { NO range checking !! }

    {
    ---------------------------------------------------------------
        This posting includes the sources for the Turbo Pascal
    version of the LZRW1/KH compression algoritm.
    ---------------------------------------------------------------
    File #1 : The LZRW1KH unit
    --------------------------
    }
    {    ###################################################################   }
    {    ##                                                               ##   }
    {    ##      ##    ##### #####  ##   ##  ##      ## ##  ## ##  ##     ##   }
    {    ##      ##      ### ##  ## ## # ## ###     ##  ## ##  ##  ##     ##   }
    {    ##      ##     ###  #####  #######  ##    ##   ####   ######     ##   }
    {    ##      ##    ###   ##  ## ### ###  ##   ##    ## ##  ##  ##     ##   }
    {    ##      ##### ##### ##  ## ##   ## #### ##     ##  ## ##  ##     ##   }
    {    ##                                                               ##   }
    {    ##   EXTREMELY FAST AND EASY TO UNDERSTAND COMPRESSION ALGORITM  ##   }
    {    ##                                                               ##   }
    {    ###################################################################   }
    {    ##                                                               ##   }
    {    ##   This unit implements the updated LZRW1/KH algoritm which    ##   }
    {    ##   also implements  some RLE coding  which is usefull  when    ##   }
    {    ##   compress files  containing  a lot  of consecutive  bytes    ##   }
    {    ##   having the same value.   The algoritm is not as good  as    ##   }
    {    ##   LZH, but can compete with Lempel-Ziff.   It's the fasted    ##   }
    {    ##   one I've encountered upto now.                              ##   }
    {    ##                                                               ##   }
    {    ##                                                               ##   }
    {    ##                                                               ##   }
    {    ##                                                Kurt HAENEN    ##   }
    {    ##                                                               ##   }
    {    ###################################################################   }

    UNIT LZRW1KH;

    INTERFACE

    uses SysUtils;

    {$IFDEF WIN32}
    type Int16 = SmallInt;
    {$ELSE}
    type Int16 = Integer;
    {$ENDIF}

    CONST
        BufferMaxSize  = 32768;
        BufferMax      = BufferMaxSize-1;
        FLAG_Copied    = $80;
        FLAG_Compress  = $40;

    TYPE
        BufferIndex    = 0..BufferMax + 15;
        BufferSize     = 0..BufferMaxSize;
           { extra bytes needed here if compression fails      *dh *}
        BufferArray    = ARRAY [BufferIndex] OF BYTE;
        BufferPtr      = ^BufferArray;

        ELzrw1KHCompressor = Class(Exception);

    FUNCTION  Compression    (    Source,Dest    : BufferPtr;
                                  SourceSize     : BufferSize   )    : BufferSize;

    FUNCTION  Decompression  (    Source,Dest    : BufferPtr;
                                  SourceSize     : BufferSize   )    : BufferSize;

    IMPLEMENTATION

    type
      HashTable      = ARRAY [0..4095] OF Int16;
      HashTabPtr     = ^Hashtable;

    VAR
      Hash                     : HashTabPtr;

                                 { check if this string has already been seen }
                                 { in the current 4 KB window }
    FUNCTION  GetMatch       (    Source         : BufferPtr;
                                  X              : BufferIndex;
                                  SourceSize     : BufferSize;
                                  Hash           : HashTabPtr;
                              VAR Size           : WORD;
                              VAR Pos            : BufferIndex  )    : BOOLEAN;
    VAR
      HashValue      : WORD;
      TmpHash        : Int16;
    BEGIN
      HashValue := (40543*((((Source^[X] SHL 4) XOR Source^[X+1]) SHL 4) XOR
                                         Source^[X+2]) SHR 4) AND $0FFF;
      Result := FALSE;
      TmpHash := Hash^[HashValue];
      IF (TmpHash <> -1) and (X - TmpHash < 4096) THEN BEGIN
        Pos := TmpHash;
        Size := 0;
        WHILE ((Size < 18) AND (Source^[X+Size] = Source^[Pos+Size])
                           AND (X+Size < SourceSize)) DO begin
          INC(Size);
        end;
        Result := (Size >= 3)
      END;
      Hash^[HashValue] := X
    END;
                                        { compress a buffer of max. 32 KB }
    FUNCTION  Compression(Source, Dest : BufferPtr;
                          SourceSize   : BufferSize) :BufferSize;
    VAR
      Bit,Command,Size         : WORD;
      Key                      : Word;
      X,Y,Z,Pos                : BufferIndex;
    BEGIN
      FillChar(Hash^,SizeOf(Hashtable), $FF);
      Dest^[0] := FLAG_Compress;
      X := 0;
      Y := 3;
      Z := 1;
      Bit := 0;
      Command := 0;
      WHILE (X < SourceSize) AND (Y <= SourceSize) DO BEGIN
        IF (Bit > 15) THEN BEGIN
          Dest^[Z] := HI(Command);
          Dest^[Z+1] := LO(Command);
          Z := Y;
          Bit := 0;
          INC(Y,2)
        END;
        Size := 1;
        WHILE ((Source^[X] = Source^[X+Size]) AND (Size < $FFF)
                             AND (X+Size < SourceSize)) DO begin
                  INC(Size);
        end;
        IF (Size >= 16) THEN BEGIN
          Dest^[Y] := 0;
          Dest^[Y+1] := HI(Size-16);
          Dest^[Y+2] := LO(Size-16);
          Dest^[Y+3] := Source^[X];
          INC(Y,4);
          INC(X,Size);
          Command := (Command SHL 1) + 1;
        END
        ELSE begin { not size >= 16 }
          IF (GetMatch(Source,X,SourceSize,Hash,Size,Pos)) THEN BEGIN
            Key := ((X-Pos) SHL 4) + (Size-3);
            Dest^[Y] := HI(Key);
            Dest^[Y+1] := LO(Key);
            INC(Y,2);
            INC(X,Size);
            Command := (Command SHL 1) + 1
          END
          ELSE BEGIN
            Dest^[Y] := Source^[X];
            INC(Y);
            INC(X);
            Command := Command SHL 1
          END;
        end; { size <= 16 }
        INC(Bit);
      END; { while x < sourcesize ... }
      Command := Command SHL (16-Bit);
      Dest^[Z] := HI(Command);
      Dest^[Z+1] := LO(Command);
      IF (Y > SourceSize) THEN BEGIN
        MOVE(Source^[0],Dest^[1],SourceSize);
        Dest^[0] := FLAG_Copied;
        Y := SUCC(SourceSize)
      END;
      Result := Y
    END;

                                        { decompress a buffer of max 32 KB }
    FUNCTION  Decompression(Source,Dest    : BufferPtr;
                            SourceSize     : BufferSize) : BufferSize;
    VAR
      X,Y,Pos                  : BufferIndex;
      Command,Size,K           : WORD;
      Bit                      : BYTE;
      SaveY                    : BufferIndex; { * dh * unsafe for-loop variable Y }

    BEGIN
      IF (Source^[0] = FLAG_Copied) THEN  begin
        FOR Y := 1 TO PRED(SourceSize) DO begin
          Dest^[PRED(Y)] := Source^[Y];
          SaveY := Y;
        end;
        Y := SaveY;
      end
      ELSE BEGIN
        Y := 0;
        X := 3;
        Command := (Source^[1] SHL 8) + Source^[2];
        Bit := 16;
        WHILE (X < SourceSize) DO BEGIN
          IF (Bit = 0) THEN BEGIN
            Command := (Source^[X] SHL 8) + Source^[X+1];
            Bit := 16;
            INC(X,2)
          END;
          IF ((Command AND $8000) = 0) THEN BEGIN
               Dest^[Y] := Source^[X];
               INC(X);
               INC(Y)
          END
          ELSE BEGIN  { command and $8000 }
            Pos := ((Source^[X] SHL 4)
                   +(Source^[X+1] SHR 4));
            IF (Pos = 0) THEN BEGIN
              Size := (Source^[X+1] SHL 8) + Source^[X+2] + 15;
              FOR K := 0 TO Size DO begin
                   Dest^[Y+K] := Source^[X+3];
              end;
              INC(X,4);
              INC(Y,Size+1)
            END
            ELSE BEGIN  { pos = 0 }
              Size := (Source^[X+1] AND $0F)+2;
              FOR K := 0 TO Size DO
                   Dest^[Y+K] := Dest^[Y-Pos+K];
              INC(X,2);
              INC(Y,Size+1)
            END; { pos = 0 }
          END;  { command and $8000 }
          Command := Command SHL 1;
          DEC(Bit)
        END { while x < sourcesize }
      END;
      Result := Y
    END;  { decompression }

    {
      Unit "Finalization" as Delphi 2.0 would have it
    }

    var
      ExitSave : Pointer;

    Procedure Cleanup; far;
    begin
      ExitProc := ExitSave;
      if (Hash <> Nil) then
        Freemem(Hash, Sizeof(HashTable));
    end;

    Initialization

      Hash := Nil;
      try
        Getmem(Hash,Sizeof(Hashtable));
      except
        Raise ELzrw1KHCompressor.Create('LZRW1KH : no memory for HASH table');
      end;
      ExitSave := ExitProc;
      ExitProc := @Cleanup;
    END.

[Back to ARCHIVES SWAG index] [Back to Main SWAG index] [Original]