Category : Pascal Source Code
Archive   : PIBLZW.ZIP
Filename : PIBLZW.INC

(*--------------------------------------------------------------------------*)
(* Terminate --- Finish output file, close files. *)
(*--------------------------------------------------------------------------*)

PROCEDURE Terminate;

BEGIN (* Terminate *)
(* Write any remaining characters *)
(* to output file. *)
IF ( Output_Pos > 0 ) THEN
BlockWrite( Output_File, Output_Buffer, Output_Pos );

Ierr := IOResult;
(* Close input and output files *)
CLOSE( Input_File );
Ierr := IOResult;

CLOSE( Output_File );
Ierr := IOResult;

END (* Terminate *);

(*--------------------------------------------------------------------------*)
(* Get_Hash_Code --- Gets hash code for given C string *)
(*--------------------------------------------------------------------------*)

FUNCTION Get_Hash_Code( PrevC, FollC : INTEGER ) : INTEGER;

VAR
Index : INTEGER;
Index2 : INTEGER;

BEGIN (* Get_Hash_Code *)
(* Get initial index using hashing *)

Index := ( ( PrevC SHL 5 ) XOR FollC ) AND MaxTab;

(* If entry not already used, return *)
(* its index as hash code for C. *)

IF ( NOT String_Table[Index].Used ) THEN
Get_Hash_Code := Index
ELSE
(* If entry already used, search to *)
(* end of list of hash collision *)
(* entries for this hash code. *)
(* Do linear probe to find an *)
(* available slot. *)
BEGIN

(* Skip to end of collision list ... *)

WHILE ( String_Table[Index].Next <> End_List ) DO
Index := String_Table[Index].Next;

(* Begin linear probe down a bit from *)
(* last entry in collision list ... *)

Index2 := ( Index + 101 ) AND MaxTab;

(* Look for unused entry using linear *)
(* probing ... *)

WHILE ( String_Table[Index2].Used ) DO
Index2 := SUCC( Index2 ) AND MaxTab;

(* Point prior end of collision list *)
(* to this new node. *)

String_Table[Index].Next := Index2;

(* Return hash code for C *)

Get_Hash_Code := Index2;

END;

END (* Get_Hash_Code *);

(*--------------------------------------------------------------------------*)
(* Make_Table_Entry --- Enter C string in string table *)
(*--------------------------------------------------------------------------*)

PROCEDURE Make_Table_Entry( PrevC, FollC: INTEGER );

BEGIN (* Make_Table_Entry *)
(* Only enter string if there is room left *)

IF ( Table_Used <= MaxTab ) THEN
BEGIN
WITH String_Table[ Get_Hash_Code( PrevC , FollC ) ] DO
BEGIN
Used := TRUE;
Next := End_List;
PrevChar := PrevC;
FollChar := FollC;
END;
(* Increment count of items used *)

INC( Table_Used );
(*
IF ( Table_Used > ( MaxTab + 1 ) ) THEN
BEGIN
WRITELN('Hash table full.');
END;
*)
END;

END (* Make_Table_Entry *);

(*--------------------------------------------------------------------------*)
(* Initialize_String_Table --- Initialize string table *)
(*--------------------------------------------------------------------------*)

PROCEDURE Initialize_String_Table;

VAR
I: INTEGER;

BEGIN (* Initialize_String_Table *)

(* No entries used in table yet *)
Table_Used := 0;
(* Clear all table entries *)
FOR I := 0 TO MaxTab DO
WITH String_Table[I] DO
BEGIN
PrevChar := No_Prev;
FollChar := No_Prev;
Next := -1;
Used := FALSE;
END;
(* Enter all single characters into *)
(* table *)
FOR I := 0 TO 255 DO
Make_Table_Entry( No_Prev , I );

END (* Initialize_String_Table *);

(*--------------------------------------------------------------------------*)
(* Initialize --- Initialize compression/decompression *)
(*--------------------------------------------------------------------------*)

PROCEDURE Initialize;

VAR
Input_Name : AnyStr (* Input file name *);
Output_Name : AnyStr (* Output file name *);

BEGIN (* Initialize *)
(* Get the input file *)
IF ( ParamCount > 0 ) THEN
Input_Name := ParamStr( 1 )
ELSE
BEGIN

CASE If_Compressing OF
TRUE: WRITE('Enter name of file to compress : ');
FALSE: WRITE('Enter name of file to decompress : ');
END (* CASE *);

READLN( Input_Name );
Ierr := IOResult;

END;
(* Open input file *)

ASSIGN ( Input_File , Input_Name );
RESET ( Input_File , 1 );
Ierr := IOResult;
(* Get the output file *)
IF ( ParamCount > 1 ) THEN
Output_Name := ParamStr( 2 )
ELSE
BEGIN

CASE If_Compressing OF
TRUE: WRITE('Enter name of output compressed file: ');
FALSE: WRITE('Enter name of output uncompressed file: ');
END (* CASE *);

READLN( Output_Name );
Ierr := IOResult;

END;
(* Open output file *)

ASSIGN ( Output_File , Output_Name );
REWRITE( Output_File , 1 );
Ierr := IOResult;
(* Point input point past end of *)
(* buffer to force initial read *)
Input_Pos := MaxBuff + 1;
(* Nothing written out yet *)
Output_Pos := 0;
(* Nothing read in yet *)
InBufSize := 0;
(* No input or output codes yet *)
(* constructed *)
Output_Code := Empty;
Input_Code := Empty;
(* Initialize string hash table *)
Initialize_String_Table;

END (* Initialize *);

(*--------------------------------------------------------------------------*)
(* Lookup_String --- Look for string C in string table *)
(*--------------------------------------------------------------------------*)

FUNCTION Lookup_String( PrevC, FollC: INTEGER ) : INTEGER;

VAR
Index : INTEGER;
Index2 : INTEGER;
Found : BOOLEAN;

BEGIN (* Lookup_String *)
(* Initialize index to check from hash *)

Index := ( ( PrevC SHL 5 ) XOR FollC ) AND MaxTab;

(* Assume we won't find string *)
Lookup_String := End_List;
(* Search through list of hash collision *)
(* entries for one that matches C *)
REPEAT

Found := ( String_Table[Index].PrevChar = PrevC ) AND
( String_Table[Index].FollChar = FollC );

IF ( NOT Found ) THEN
Index := String_Table[Index].Next;

UNTIL Found OR ( Index = End_List );

(* Return index if C found in table. *)
IF Found THEN
Lookup_String := Index;

END (* Lookup_String *);

(*--------------------------------------------------------------------------*)
(* Get_Char --- Read character from input file *)
(*--------------------------------------------------------------------------*)

PROCEDURE Get_Char( VAR C: INTEGER );

BEGIN (* Get_Char *)
(* Point to next character in buffer *)
INC( Input_Pos );
(* If past end of block read in, then *)
(* reset input pointer and read in *)
(* next block. *)

IF ( Input_Pos > InBufSize ) THEN
BEGIN
BlockRead( Input_File, Input_Buffer, MaxBuff, InBufSize );
Input_Pos := 1;
Ierr := IOResult;
END;
(* If end of file hit, return EOF_Char *)
(* otherwise return next character in *)
(* input buffer. *)
IF ( InBufSize = 0 ) THEN
C := EOF_Char
ELSE
C := Input_Buffer[Input_Pos];

END (* Get_Char *);

(*--------------------------------------------------------------------------*)
(* Write_Char --- Write character to output file *)
(*--------------------------------------------------------------------------*)

PROCEDURE Put_Char( C : INTEGER );

BEGIN (* Put_Char *)
(* If buffer full, write it out and *)
(* reset output buffer pointer. *)

IF ( Output_Pos >= MaxBuff ) THEN
BEGIN
BlockWrite( Output_File, Output_Buffer, MaxBuff );
Output_Pos := 0;
Ierr := IOResult;
END;
(* Place character in next slot in *)
(* output buffer. *)

INC( Output_Pos );
Output_Buffer[Output_Pos] := C;

END (* Put_Char *);