home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBLZW.ZIP / PIBLZW.INC < prev    next >
Encoding:
Text File  |  1988-04-30  |  10.2 KB  |  295 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*          Terminate --- Finish output file, close files.                  *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Terminate;
  6.  
  7. BEGIN (* Terminate *)
  8.                                    (* Write any remaining characters *)
  9.                                    (* to output file.                *)
  10.    IF ( Output_Pos > 0 ) THEN
  11.       BlockWrite( Output_File, Output_Buffer, Output_Pos );
  12.  
  13.    Ierr := IOResult;
  14.                                    (* Close input and output files   *)
  15.    CLOSE( Input_File  );
  16.    Ierr := IOResult;
  17.  
  18.    CLOSE( Output_File );
  19.    Ierr := IOResult;
  20.  
  21. END   (* Terminate *);
  22.  
  23. (*--------------------------------------------------------------------------*)
  24. (*          Get_Hash_Code --- Gets hash code for given <w>C string          *)
  25. (*--------------------------------------------------------------------------*)
  26.  
  27. FUNCTION Get_Hash_Code( PrevC, FollC : INTEGER ) : INTEGER;
  28.  
  29. VAR
  30.    Index  : INTEGER;
  31.    Index2 : INTEGER;
  32.  
  33. BEGIN (* Get_Hash_Code *)
  34.                                    (* Get initial index using hashing *)
  35.  
  36.    Index := ( ( PrevC SHL 5 ) XOR FollC ) AND MaxTab;
  37.  
  38.                                    (* If entry not already used, return *)
  39.                                    (* its index as hash code for <w>C.  *)
  40.  
  41.    IF ( NOT String_Table[Index].Used ) THEN
  42.       Get_Hash_Code := Index
  43.    ELSE
  44.                                    (* If entry already used, search to  *)
  45.                                    (* end of list of hash collision     *)
  46.                                    (* entries for this hash code.       *)
  47.                                    (* Do linear probe to find an        *)
  48.                                    (* available slot.                   *)
  49.       BEGIN
  50.  
  51.                                    (* Skip to end of collision list ... *)
  52.  
  53.          WHILE ( String_Table[Index].Next <> End_List ) DO
  54.             Index := String_Table[Index].Next;
  55.  
  56.                                    (* Begin linear probe down a bit from  *)
  57.                                    (* last entry in collision list ...    *)
  58.  
  59.          Index2 := ( Index + 101 ) AND MaxTab;
  60.  
  61.                                    (* Look for unused entry using linear  *)
  62.                                    (* probing ...                         *)
  63.  
  64.          WHILE ( String_Table[Index2].Used ) DO
  65.             Index2 := SUCC( Index2 ) AND MaxTab;
  66.  
  67.                                    (* Point prior end of collision list   *)
  68.                                    (* to this new node.                   *)
  69.  
  70.          String_Table[Index].Next := Index2;
  71.  
  72.                                    (* Return hash code for <w>C           *)
  73.  
  74.          Get_Hash_Code          := Index2;
  75.  
  76.       END;
  77.  
  78. END   (* Get_Hash_Code *);
  79.  
  80. (*--------------------------------------------------------------------------*)
  81. (*          Make_Table_Entry --- Enter <w>C string in string table          *)
  82. (*--------------------------------------------------------------------------*)
  83.  
  84. PROCEDURE Make_Table_Entry( PrevC, FollC: INTEGER );
  85.  
  86. BEGIN (* Make_Table_Entry *)
  87.                                    (* Only enter string if there is room left *)
  88.  
  89.    IF ( Table_Used <= MaxTab ) THEN
  90.       BEGIN
  91.          WITH String_Table[ Get_Hash_Code( PrevC , FollC ) ] DO
  92.             BEGIN
  93.                Used     := TRUE;
  94.                Next     := End_List;
  95.                PrevChar := PrevC;
  96.                FollChar := FollC;
  97.             END;
  98.                                    (* Increment count of items used *)
  99.  
  100.          INC( Table_Used );
  101. (*
  102.          IF ( Table_Used > ( MaxTab + 1 ) ) THEN
  103.             BEGIN
  104.                WRITELN('Hash table full.');
  105.             END;
  106. *)
  107.       END;
  108.  
  109. END   (* Make_Table_Entry *);
  110.  
  111. (*--------------------------------------------------------------------------*)
  112. (*            Initialize_String_Table --- Initialize string table           *)
  113. (*--------------------------------------------------------------------------*)
  114.  
  115. PROCEDURE Initialize_String_Table;
  116.  
  117. VAR
  118.    I: INTEGER;
  119.  
  120. BEGIN (* Initialize_String_Table *)
  121.  
  122.                                    (* No entries used in table yet *)
  123.    Table_Used  := 0;
  124.                                    (* Clear all table entries      *)
  125.    FOR I := 0 TO MaxTab DO
  126.       WITH String_Table[I] DO
  127.          BEGIN
  128.             PrevChar := No_Prev;
  129.             FollChar := No_Prev;
  130.             Next     := -1;
  131.             Used     := FALSE;
  132.          END;
  133.                                    (* Enter all single characters into *)
  134.                                    (* table                            *)
  135.    FOR I := 0 TO 255 DO
  136.       Make_Table_Entry( No_Prev , I );
  137.  
  138. END   (* Initialize_String_Table *);
  139.  
  140. (*--------------------------------------------------------------------------*)
  141. (*            Initialize --- Initialize compression/decompression           *)
  142. (*--------------------------------------------------------------------------*)
  143.  
  144. PROCEDURE Initialize;
  145.  
  146. VAR
  147.    Input_Name  : AnyStr            (* Input file name  *);
  148.    Output_Name : AnyStr            (* Output file name *);
  149.  
  150. BEGIN (* Initialize *)
  151.                                    (* Get the input file *)
  152.    IF ( ParamCount > 0 ) THEN
  153.       Input_Name := ParamStr( 1 )
  154.    ELSE
  155.       BEGIN
  156.  
  157.          CASE If_Compressing OF
  158.             TRUE:  WRITE('Enter name of file to compress      : ');
  159.             FALSE: WRITE('Enter name of file to decompress      : ');
  160.          END (* CASE *);
  161.  
  162.          READLN( Input_Name );
  163.          Ierr := IOResult;
  164.  
  165.       END;
  166.                                    (* Open input file *)
  167.  
  168.    ASSIGN ( Input_File , Input_Name );
  169.    RESET  ( Input_File , 1 );
  170.    Ierr := IOResult;
  171.                                    (* Get the output file *)
  172.    IF ( ParamCount > 1 ) THEN
  173.       Output_Name := ParamStr( 2 )
  174.    ELSE
  175.       BEGIN
  176.  
  177.          CASE If_Compressing OF
  178.             TRUE:  WRITE('Enter name of output compressed file: ');
  179.             FALSE: WRITE('Enter name of output uncompressed file: ');
  180.          END (* CASE *);
  181.  
  182.          READLN( Output_Name );
  183.          Ierr := IOResult;
  184.  
  185.       END;
  186.                                    (* Open output file *)
  187.  
  188.    ASSIGN ( Output_File , Output_Name );
  189.    REWRITE( Output_File , 1 );
  190.    Ierr := IOResult;
  191.                                    (* Point input point past end of *)
  192.                                    (* buffer to force initial read  *)
  193.    Input_Pos  := MaxBuff + 1;
  194.                                    (* Nothing written out yet       *)
  195.    Output_Pos := 0;
  196.                                    (* Nothing read in yet           *)
  197.    InBufSize  := 0;
  198.                                    (* No input or output codes yet  *)
  199.                                    (* constructed                   *)
  200.    Output_Code := Empty;
  201.    Input_Code  := Empty;
  202.                                    (* Initialize string hash table  *)
  203.    Initialize_String_Table;
  204.  
  205. END   (* Initialize *);
  206.  
  207. (*--------------------------------------------------------------------------*)
  208. (*            Lookup_String --- Look for string <w>C in string table        *)
  209. (*--------------------------------------------------------------------------*)
  210.  
  211. FUNCTION Lookup_String( PrevC, FollC: INTEGER ) : INTEGER;
  212.  
  213. VAR
  214.    Index  : INTEGER;
  215.    Index2 : INTEGER;
  216.    Found  : BOOLEAN;
  217.  
  218. BEGIN (* Lookup_String *)
  219.                                    (* Initialize index to check from hash *)
  220.  
  221.    Index       := ( ( PrevC SHL 5 ) XOR FollC ) AND MaxTab;
  222.  
  223.                                    (* Assume we won't find string *)
  224.    Lookup_String := End_List;
  225.                                    (* Search through list of hash collision *)
  226.                                    (* entries for one that matches <w>C     *)
  227.    REPEAT
  228.  
  229.       Found := ( String_Table[Index].PrevChar = PrevC ) AND
  230.                ( String_Table[Index].FollChar = FollC );
  231.  
  232.       IF ( NOT Found ) THEN
  233.          Index := String_Table[Index].Next;
  234.  
  235.    UNTIL Found OR ( Index = End_List );
  236.  
  237.                                    (* Return index if <w>C found in table. *)
  238.    IF Found THEN
  239.       Lookup_String := Index;
  240.  
  241. END   (* Lookup_String *);
  242.  
  243. (*--------------------------------------------------------------------------*)
  244. (*              Get_Char  ---  Read character from input file               *)
  245. (*--------------------------------------------------------------------------*)
  246.  
  247. PROCEDURE Get_Char( VAR C: INTEGER );
  248.  
  249. BEGIN (* Get_Char *)
  250.                                    (* Point to next character in buffer *)
  251.    INC( Input_Pos );
  252.                                    (* If past end of block read in, then *)
  253.                                    (* reset input pointer and read in    *)
  254.                                    (* next block.                        *)
  255.  
  256.    IF ( Input_Pos > InBufSize ) THEN
  257.       BEGIN
  258.          BlockRead( Input_File, Input_Buffer, MaxBuff, InBufSize );
  259.          Input_Pos := 1;
  260.          Ierr      := IOResult;
  261.       END;
  262.                                   (* If end of file hit, return EOF_Char *)
  263.                                   (* otherwise return next character in  *)
  264.                                   (* input buffer.                       *)
  265.    IF ( InBufSize = 0 ) THEN
  266.       C := EOF_Char
  267.    ELSE
  268.       C := Input_Buffer[Input_Pos];
  269.  
  270. END   (* Get_Char *);
  271.  
  272. (*--------------------------------------------------------------------------*)
  273. (*             Write_Char  ---  Write character to output file              *)
  274. (*--------------------------------------------------------------------------*)
  275.  
  276. PROCEDURE Put_Char( C : INTEGER );
  277.  
  278. BEGIN (* Put_Char *)
  279.                                    (* If buffer full, write it out and *)
  280.                                    (* reset output buffer pointer.     *)
  281.  
  282.    IF ( Output_Pos >= MaxBuff ) THEN
  283.       BEGIN
  284.          BlockWrite( Output_File, Output_Buffer, MaxBuff );
  285.          Output_Pos := 0;
  286.          Ierr       := IOResult;
  287.       END;
  288.                                    (* Place character in next slot in  *)
  289.                                    (* output buffer.                   *)
  290.  
  291.    INC( Output_Pos );
  292.    Output_Buffer[Output_Pos] := C;
  293.  
  294. END   (* Put_Char *);
  295.