home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / packer / lzw / lzrw1kh.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-05-19  |  21.4 KB  |  475 lines
  1.  
  2. ---------------------------------------------------------------
  3.     This posting includes the sources for the Turbo Pascal
  4. version of the LZRW1/KH compression algoritm.
  5. ---------------------------------------------------------------
  6. File #1 : The LZRW1KH unit
  7. --------------------------
  8.  
  9. {    ###################################################################   }
  10. {    ##                                                               ##   }
  11. {    ##      ##    ##### #####  ##   ##  ##      ## ##  ## ##  ##     ##   }
  12. {    ##      ##      ### ##  ## ## # ## ###     ##  ## ##  ##  ##     ##   }
  13. {    ##      ##     ###  #####  #######  ##    ##   ####   ######     ##   }
  14. {    ##      ##    ###   ##  ## ### ###  ##   ##    ## ##  ##  ##     ##   }
  15. {    ##      ##### ##### ##  ## ##   ## #### ##     ##  ## ##  ##     ##   }
  16. {    ##                                                               ##   }
  17. {    ##   EXTREMELY FAST AND EASY TO UNDERSTAND COMPRESSION ALGORITM  ##   }
  18. {    ##                                                               ##   }
  19. {    ###################################################################   }
  20. {    ##                                                               ##   }
  21. {    ##   This unit implements the updated LZRW1/KH algoritm which    ##   }
  22. {    ##   also implements  some RLE coding  which is usefull  when    ##   }
  23. {    ##   compress files  containing  a lot  of consecutive  bytes    ##   }
  24. {    ##   having the same value.   The algoritm is not as good  as    ##   }
  25. {    ##   LZH, but can compete with Lempel-Ziff.   It's the fasted    ##   }
  26. {    ##   one I've encountered upto now.                              ##   }
  27. {    ##                                                               ##   }
  28. {    ##                                                               ##   }
  29. {    ##                                                               ##   }
  30. {    ##                                                Kurt HAENEN    ##   }
  31. {    ##                                                               ##   }
  32. {    ###################################################################   }
  33.  
  34. UNIT LZRW1KH;
  35.  
  36. INTERFACE
  37.  
  38. CONST     BufferMaxSize  = 32768;
  39.           BufferMax      = BufferMaxSize-1;
  40.           FLAG_Copied    = $80;
  41.           FLAG_Compress  = $40;
  42.  
  43. TYPE BufferIndex    = 0..BufferMax;
  44.      BufferSize     = 0..BufferMaxSize;
  45.      BufferArray    = ARRAY [BufferIndex] OF BYTE;
  46.      BufferPtr      = ^BufferArray;
  47.  
  48. FUNCTION  Compression    (    Source,Dest    : BufferPtr;
  49.                               SourceSize     : BufferSize   )    : BufferSize;
  50.  
  51. FUNCTION  Decompression  (    Source,Dest    : BufferPtr;
  52.                               SourceSize     : BufferSize   )    : BufferSize;
  53.  
  54. IMPLEMENTATION
  55.  
  56. TYPE HashTable      = ARRAY [0..4095] OF INTEGER;
  57.  
  58. FUNCTION  GetMatch       (    Source         : BufferPtr;
  59.                               X              : BufferIndex;
  60.                               SourceSize     : BufferSize;
  61.                           VAR Hash           : HashTable;
  62.                           VAR Size           : WORD;
  63.                           VAR Pos            : BufferIndex  )    : BOOLEAN;
  64. VAR  HashValue      : WORD;
  65. BEGIN
  66.      HashValue := (40543*((((Source^[X] SHL 4) XOR Source^[X+1]) SHL 4) XOR
  67.                  Source^[X+2]) SHR 4) AND $0FFF;
  68.      GetMatch := FALSE;
  69.      IF (Hash[HashValue] <> -1) AND (X-Hash[HashValue] < 4096) THEN
  70.           BEGIN
  71.                Pos := Hash[HashValue];
  72.                Size := 0;
  73.                WHILE ((Size < 18) AND (Source^[X+Size] = Source^[Pos+Size])
  74.                     AND (X+Size < SourceSize)) DO
  75.                     INC(Size);
  76.                GetMatch := (Size >= 3)
  77.           END;
  78.      Hash[HashValue] := X
  79. END;
  80.  
  81.  
  82. FUNCTION  Compression    (    Source,Dest    : BufferPtr;
  83.                               SourceSize     : BufferSize   )    : BufferSize;
  84. VAR  Hash                     : HashTable;
  85.      Key,Bit,Command,Size     : WORD;
  86.      X,Y,Z,Pos                : BufferIndex;
  87. BEGIN
  88.      FOR Key := 0 TO 4095 DO Hash[Key] := -1;
  89.      Dest^[0] := FLAG_Compress;
  90.      X := 0;
  91.      Y := 3;
  92.      Z := 1;
  93.      Bit := 0;
  94.      Command := 0;
  95.      WHILE (X < SourceSize) AND (Y <= SourceSize) DO
  96.           BEGIN
  97.                IF (Bit > 15) THEN
  98.                     BEGIN
  99.                          Dest^[Z] := HI(Command);
  100.                          Dest^[Z+1] := LO(Command);
  101.                          Z := Y;
  102.                          Bit := 0;
  103.                          INC(Y,2)
  104.                     END;
  105.                Size := 1;
  106.                WHILE ((Source^[X] = Source^[X+Size]) AND (Size < $FFF)
  107.                     AND (X+Size < SourceSize)) DO
  108.                          INC(Size);
  109.                IF (Size >= 16)
  110.                     THEN BEGIN
  111.                               Dest^[Y] := 0;
  112.                               Dest^[Y+1] := HI(Size-16);
  113.                               Dest^[Y+2] := LO(Size-16);
  114.                               Dest^[Y+3] := Source^[X];
  115.                               INC(Y,4);
  116.                               INC(X,Size);
  117.                               Command := (Command SHL 1) + 1
  118.                          END
  119.                     ELSE IF (GetMatch(Source,X,SourceSize,Hash,Size,Pos))
  120.                               THEN BEGIN
  121.                                         Key := ((X-Pos) SHL 4) + (Size-3);
  122.                                         Dest^[Y] := HI(Key);
  123.                                         Dest^[Y+1] := LO(Key);
  124.                                         INC(Y,2);
  125.                                         INC(X,Size);
  126.                                         Command := (Command SHL 1) + 1
  127.                                    END
  128.                               ELSE BEGIN
  129.                                         Dest^[Y] := Source^[X];
  130.                                         INC(Y);
  131.                                         INC(X);
  132.                                         Command := Command SHL 1
  133.                                    END;
  134.                INC(Bit);
  135.           END;
  136.      Command := Command SHL (16-Bit);
  137.      Dest^[Z] := HI(Command);
  138.      Dest^[Z+1] := LO(Command);
  139.      IF (Y > SourceSize) THEN
  140.           BEGIN
  141.                MOVE(Source^[0],Dest^[1],SourceSize);
  142.                Dest^[0] := FLAG_Copied;
  143.                Y := SUCC(SourceSize)
  144.           END;
  145.      Compression := Y
  146. END;
  147.  
  148. FUNCTION  Decompression  (    Source,Dest    : BufferPtr;
  149.                               SourceSize     : BufferSize   )    : BufferSize;
  150. VAR  X,Y,Pos                  : BufferIndex;
  151.      Command,Size,K           : WORD;
  152.      Bit                      : BYTE;
  153. BEGIN
  154.      IF (Source^[0] = FLAG_Copied)
  155.           THEN FOR Y := 1 TO PRED(SourceSize) DO
  156.                     Dest^[PRED(Y)] := Source^[Y]
  157.           ELSE BEGIN
  158.                     Y := 0;
  159.                     X := 3;
  160.                     Command := (Source^[1] SHL 8)+Source^[2];
  161.                     Bit := 16;
  162.                     WHILE (X < SourceSize) DO
  163.                          BEGIN
  164.                               IF (Bit = 0) THEN
  165.                                    BEGIN
  166.                                         Command := (Source^[X] SHL 8)
  167.                                                       +Source^[X+1];
  168.                                         Bit := 16;
  169.                                         INC(X,2)
  170.                                    END;
  171.                               IF ((Command AND $8000) = 0)
  172.                                    THEN BEGIN
  173.                                              Dest^[Y] := Source^[X];
  174.                                              INC(X);
  175.                                              INC(Y)
  176.                                         END
  177.                                    ELSE BEGIN
  178.                                              Pos := ((Source^[X] SHL 4)
  179.                                                     +(Source^[X+1] SHR 4));
  180.                                              IF (Pos = 0)
  181.                                                   THEN BEGIN
  182. {----------------------------------------------------------------}
  183.      Size := (Source^[X+1] SHL 8) + Source^[X+2] + 15;
  184.      FOR K := 0 TO Size DO
  185.           Dest^[Y+K] := Source^[X+3];
  186.      INC(X,4);
  187.      INC(Y,Size+1)
  188. {----------------------------------------------------------------}
  189.                                                        END
  190.                                                   ELSE BEGIN
  191. {----------------------------------------------------------------}
  192.      Size := (Source^[X+1] AND $0F)+2;
  193.      FOR K := 0 TO Size DO
  194.           Dest^[Y+K] := Dest^[Y-Pos+K];
  195.      INC(X,2);
  196.      INC(Y,Size+1)
  197. {----------------------------------------------------------------}
  198.                                                        END;
  199.                                         END;
  200.                               Command := Command SHL 1;
  201.                               DEC(Bit)
  202.                          END
  203.                END;
  204.      Decompression := Y
  205. END;
  206.  
  207. END.
  208.  
  209. -------------------------------------------------------------------
  210. End of File # 1
  211.  
  212.  
  213.  
  214. File #2 : A small demonstration
  215. -------------------------------
  216.  
  217.  
  218. {    ###################################################################   }
  219. {    ##                                                               ##   }
  220. {    ##      ##    ##### #####  ##   ##  ##      ## ##  ## ##  ##     ##   }
  221. {    ##      ##      ### ##  ## ## # ## ###     ##  ## ##  ##  ##     ##   }
  222. {    ##      ##     ###  #####  #######  ##    ##   ####   ######     ##   }
  223. {    ##      ##    ###   ##  ## ### ###  ##   ##    ## ##  ##  ##     ##   }
  224. {    ##      ##### ##### ##  ## ##   ## #### ##     ##  ## ##  ##     ##   }
  225. {    ##                                                               ##   }
  226. {    ##   EXTREMELY FAST AND EASY TO UNDERSTAND COMPRESSION ALGORITM  ##   }
  227. {    ##                                                               ##   }
  228. {    ###################################################################   }
  229. {    ##                                                               ##   }
  230. {    ##   In an earlier posting I've already presented a 680x0        ##   }
  231. {    ##   assembler routine to implement optimized LZRW1 compression. ##   }
  232. {    ##   I've chosen then name LZRW1/KH for this optimized           ##   }
  233. {    ##   algoritm, to distinguish it from the original one.  The     ##   }
  234. {    ##   changes can be found in the maximum length for a match,     ##   }
  235. {    ##   which is 16 in the original algoritm, but 18 in the         ##   }
  236. {    ##   optimized one.  This is not a big change, but nevertheless  ##   }
  237. {    ##   it can increase the compression by 1/8.  Another thing      ##   }
  238. {    ##   I've tried to do is to make this program easy to            ##   }
  239. {    ##   understand.  Although I have some knowledge of C, I always  ##   }
  240. {    ##   find it difficult to understand someone else his programs.  ##   }
  241. {    ##   Especially if they depend on the SHORT CIRCUIT BOOLEAN      ##   }
  242. {    ##   evaluation of C : Test || Test || Test will only be         ##   }
  243. {    ##   executed fully if Test was TRUE the first three times ...   ##   }
  244. {    ##   Took me awhile to figure it out, although it seems quite    ##   }
  245. {    ##   natural now ... Enough of this, let's see some code ...     ##   }
  246. {    ##                                                               ##   }
  247. {    ##   Sorry, no list of people to thank this time ... It hasn't   ##   }
  248. {    ##   changed since my last posting.                              ##   }
  249. {    ##                                                Kurt Haenen    ##   }
  250. {    ##                                                               ##   }
  251. {    ###################################################################   }
  252.  
  253. PROGRAM   CompressionDemo(input,output);
  254.  
  255. USES LZRW1KH;
  256.  
  257. CONST     CompIdentifier : LONGINT      = (((((((ORD('L') SHL 8)+ORD('Z'))
  258.                                    SHL 8)+ORD('R')) SHL 8)+ORD('W')) SHL 8);
  259.  
  260. VAR  SRCFP,DSTFP         : FILE;
  261.      SRCBuf,DSTBuf       : ARRAY [0..16390] OF BYTE;
  262.      SRCSize,DSTSize     : WORD;
  263.      Tmp                 : WORD;
  264.      Identifier          : LONGINT;
  265.      InSize,OutSize      : LONGINT;
  266.  
  267. BEGIN
  268.      IF ((PARAMCOUNT <> 2) AND ((PARAMCOUNT <> 3) OR (PARAMSTR(1) <> '-D')))
  269.              THEN
  270.           BEGIN
  271.                WRITELN;
  272.                WRITELN('USAGE : COMPRESS [-D] <Source File> <Dest File>');
  273.                WRITELN('        (The -D option is case sensitive !)');
  274.                WRITELN;
  275.                HALT
  276.           END;
  277.      IF (PARAMCOUNT = 2)
  278.           THEN BEGIN
  279.                     WRITELN('TRYING TO COMPRESS ',PARAMSTR(1),' TO ',
  280.                                     PARAMSTR(2),'.');
  281.                     ASSIGN(SRCFP,PARAMSTR(1));
  282.                     ASSIGN(DSTFP,PARAMSTR(2));
  283.                     RESET(SRCFP,1);
  284.                     IF (IOResult <> 0) THEN
  285.                          BEGIN
  286.                               WRITELN;
  287.                               WRITELN('FILE ',PARAMSTR(1),' NOT FOUND !');
  288.                               WRITELN;
  289.                               HALT
  290.                          END;
  291.                     REWRITE(DSTFP,1);
  292.                     IF (IOResult <> 0) THEN
  293.                          BEGIN
  294.                               CLOSE(SRCFP);
  295.                               WRITELN;
  296.                               WRITELN('FILE ',PARAMSTR(2),' COULD NOT '+
  297.                                                    'BE OPENED !');
  298.                               WRITELN;
  299.                               HALT
  300.                          END;
  301.                     BLOCKWRITE(DSTFP,CompIdentifier,SIZEOF(LONGINT),Tmp);
  302.                     IF (Tmp <> SIZEOF(LONGINT)) THEN
  303.                          BEGIN
  304.                               CLOSE(SRCFP);
  305.                               CLOSE(DSTFP);
  306.                               ERASE(DSTFP);
  307.                               WRITELN;
  308.                               WRITELN('ERROR WRITING TO ',PARAMSTR(2),' !');
  309.                               WRITELN;
  310.                               HALT
  311.                          END;
  312.                     SRCSize := 16384;
  313.                     InSize := 0;
  314.                     OutSize := SIZEOF(LONGINT);
  315.                     WHILE (SRCSize = 16384) DO
  316.                          BEGIN
  317.                               BLOCKREAD(SRCFP,SRCBuf[0],16384,SRCSize);
  318.                               INC(InSize,SRCSize);
  319.                               WRITE('READ : ',InSize,'  WRITTEN : ',
  320.                                             OutSize,#13);
  321.                               DSTSize := Compression(ADDR(SRCBuf[0]),
  322.                                               ADDR(DSTBuf[0]),SRCSize);
  323.                               BLOCKWRITE(DSTFP,DSTSize,SIZEOF(WORD),Tmp);
  324.                               INC(OutSize,Tmp);
  325.                               WRITE('READ : ',InSize,'  WRITTEN : ',
  326.                                              OutSize,#13);
  327.                               IF (Tmp <> SIZEOF(WORD)) THEN
  328.                                    BEGIN
  329.                                         CLOSE(SRCFP);
  330.                                         CLOSE(DSTFP);
  331.                                         ERASE(DSTFP);
  332.                                         WRITELN;
  333.                                         WRITELN('ERROR WRITING TO ',
  334.                                                PARAMSTR(2),' !');
  335.                                         WRITELN;
  336.                                         HALT
  337.                                    END;
  338.                               BLOCKWRITE(DSTFP,DSTBuf[0],DSTSize,Tmp);
  339.                               INC(OutSize,Tmp);
  340.                               WRITE('READ : ',InSize,'  WRITTEN : ',
  341.                                    OutSize,#13);
  342.                               IF (Tmp <> DSTSize) THEN
  343.                                    BEGIN
  344.                                         CLOSE(SRCFP);
  345.                                         CLOSE(DSTFP);
  346.                                         ERASE(DSTFP);
  347.                                         WRITELN;
  348.                                         WRITELN('ERROR WRITING TO ',
  349.                                                    PARAMSTR(2),' !');
  350.                                         WRITELN;
  351.                                         HALT
  352.                                    END;
  353.                          END;
  354.                     WRITELN;
  355.                     WRITELN('FILE SUCCESFULLY COMPRESSED !');
  356.                     CLOSE(SRCFP);
  357.                     CLOSE(DSTFP)
  358.                END
  359.           ELSE BEGIN
  360.                     WRITELN('TRYING TO DECOMPRESS ',PARAMSTR(2),' TO ',
  361.                                        PARAMSTR(3),'.');
  362.                     ASSIGN(SRCFP,PARAMSTR(2));
  363.                     ASSIGN(DSTFP,PARAMSTR(3));
  364.                     RESET(SRCFP,1);
  365.                     IF (IOResult <> 0) THEN
  366.                          BEGIN
  367.                               WRITELN;
  368.                               WRITELN('FILE ',PARAMSTR(2),' NOT FOUND !');
  369.                               WRITELN;
  370.                               HALT
  371.                          END;
  372.                     REWRITE(DSTFP,1);
  373.                     IF (IOResult <> 0) THEN
  374.                          BEGIN
  375.                               CLOSE(SRCFP);
  376.                               WRITELN;
  377.                               WRITELN('FILE ',PARAMSTR(3),' COULD NOT '+
  378.                                                       'BE OPENED !');
  379.                               WRITELN;
  380.                               HALT
  381.                          END;
  382.                     BLOCKREAD(SRCFP,Identifier,SIZEOF(LONGINT),Tmp);
  383.                     IF (Tmp <> SIZEOF(LONGINT)) THEN
  384.                          BEGIN
  385.                               CLOSE(SRCFP);
  386.                               CLOSE(DSTFP);
  387.                               ERASE(DSTFP);
  388.                               WRITELN;
  389.                               WRITELN('ERROR READING FROM ',PARAMSTR(2),' !');
  390.                               WRITELN;
  391.                               HALT
  392.                          END;
  393.                     IF (Identifier <> CompIdentifier) THEN
  394.                          BEGIN
  395.                               CLOSE(SRCFP);
  396.                               CLOSE(DSTFP);
  397.                               ERASE(DSTFP);
  398.                               WRITELN;
  399.                               WRITELN('FILE ',PARAMSTR(2),
  400.                                             ' IS NOT A COMPRESSED FILE !');
  401.                               WRITELN;
  402.                               HALT
  403.                          END;
  404.                     DSTSize := 16384;
  405.                     InSize := SIZEOF(LONGINT);
  406.                     OutSize := 0;
  407.                     WHILE (DSTSize = 16384) DO
  408.                          BEGIN
  409.                               BLOCKREAD(SRCFP,SRCSize,SIZEOF(WORD),Tmp);
  410.                               IF (Tmp <> SIZEOF(WORD)) THEN
  411.                                    BEGIN
  412.                                         CLOSE(SRCFP);
  413.                                         CLOSE(DSTFP);
  414.                                         ERASE(DSTFP);
  415.                                         WRITELN;
  416.                                         WRITELN('ERROR READING FROM ',
  417.                                               PARAMSTR(2),' !');
  418.                                         WRITELN;
  419.                                         HALT
  420.                                    END;
  421.                               BLOCKREAD(SRCFP,SRCBuf[0],SRCSize,Tmp);
  422.                               INC(InSize,Tmp+SIZEOF(WORD));
  423.                               WRITE('READ : ',InSize,'  WRITTEN : ',
  424.                                         OutSize,#13);
  425.                               IF (Tmp <> SRCSize) THEN
  426.                                    BEGIN
  427.                                         CLOSE(SRCFP);
  428.                                         CLOSE(DSTFP);
  429.                                         ERASE(DSTFP);
  430.                                         WRITELN;
  431.                                         WRITELN('ERROR READING FROM ',
  432.                                                   PARAMSTR(2),' !');
  433.                                         WRITELN;
  434.                                         HALT
  435.                                    END;
  436.                               DSTSize := Decompression(ADDR(SRCBuf[0]),
  437.                                                ADDR(DstBuf[0]),SRCSize);
  438.                               BLOCKWRITE(DSTFP,DSTBuf[0],DSTSize,Tmp);
  439.                               INC(OutSize,Tmp);
  440.                               WRITE('READ : ',InSize,'  WRITTEN : ',
  441.                                             OutSize,#13);
  442.                               IF (Tmp <> DSTSize) THEN
  443.                                    BEGIN
  444.                                         CLOSE(SRCFP);
  445.                                         CLOSE(DSTFP);
  446.                                         ERASE(DSTFP);
  447.                                         WRITELN;
  448.                                         WRITELN('ERROR WRITING TO ',
  449.                                                    PARAMSTR(3),' !');
  450.                                         WRITELN;
  451.                                         HALT
  452.                                    END;
  453.                          END;
  454.                     WRITELN;
  455.                     WRITELN('FILE SUCCESFULLY DECOMPRESSED !');
  456.                     CLOSE(SRCFP);
  457.                     CLOSE(DSTFP)
  458.                END
  459. END.
  460.  
  461. -------------------------------------------------------------------
  462. End of file # 2
  463.  
  464.  
  465. Ok, that was the listing ...   I hope everything is ok.  Some of
  466. you may get some word-wraps etc. because of the long lines I used
  467. in the source.  I tried to make them as readable as possible, but
  468. sometime I had to include some backwards indented blocks, which
  469. are separated from the rest of the program by {----}.  I hope this
  470. still remains readable ... Hope to hear from you all soon ...
  471.  
  472.                                                     Kurt Haenen
  473.  
  474.  
  475.