From:	CRDGW2::CRDGW2::MRGATE::"SMTP::KCGL1.ENG.OHIO-STATE.EDU::JONESD" 21-JUN-1989 14:22
To:	MRGATE::"ARISIA::EVERHART"
Subj:	RE: Compress/decompress

Message-Id:  <8906211808.AA12945@crdgw1.ge.com>
Date: Wed, 21 Jun 89 14:08 EDT
From: Dave Jones <JONESD@kcgl1.eng.ohio-state.edu>
Subject: RE: Compress/decompress
To: EVERHART@ARISIA.decnet
X-Vms-To: IN%"EVERHART%ARISIA.decnet@CRDGW1.GE.COM"

Below are the routines I mentioned in my previous post.  My gut feeling is
that 512 bytes is too small a sample unit to make efficient use of Lempel-Ziv.
You might consider having the compression be performed on virtual 'tracks'
instead of individual blocks.

>>Dave
-------------------------------------------------------------------------------
C	Manage code table for Lemel-Ziv compression algorithm.
C	    Function LZ_COMPRESS ( get, put, maxc, clear, stream )
C	    Function LZ_DECOMPRESS ( get, put, maxc, clear, stream )
C	    Routine LZ_CLEAR_LOOKUP_TABLE ( MAX_CHAR )
C	    Routine LZ_LOOKUP_CODE ( PREFIX, CHAR, CODE, NEW )
C	    Routine LZ_GET_CODE_INFO ( CODE, PREFIX, CHAR )
C
	INTEGER FUNCTION LZ_COMPRESS ( GET, PUT, MAX_CHAR, CLEAR_CODE,
	1	STREAMS )
C+
C	Perform LZ compression.
C
C	Input:
C	    GET		External routine.  Get next character code.
C			GET ( STREAMS, CHAR )
C	    PUT		External routine.  Output compressed code, take
C			special actions for certain output values.
C			PUT ( OUT_BITS, STREAMS, CODE )
C	    MAX_CHAR	Integer.  Maximum input data value returned by
C			GET.  Code value <= MAX_CHAR are single strings,
C			those greater are codes for multi-char strings.
C	    CLEAR_CODE  Integer.  Code value for table reset operation.
C	    STREAMS	Structure(unspecified).  Context variable for
C			GET and PUT.
C-
	IMPLICIT NONE
	INTEGER GET, PUT, MAX_CHAR, CLEAR_CODE, STREAMS(100)
	EXTERNAL GET, PUT
	INTEGER CHAR, CODE, PREFIX, STATUS, LZ_MAX_BIT, NEW, OUT_BITS
C
C	Initialize, clear the table and get first character to be initial
C	prefix.
C
10	CALL LZ_CLEAR_LOOKUP_TABLE ( MAX_CHAR )
	OUT_BITS = LZ_MAX_BIT ( 1, MAX_CHAR )
	LZ_COMPRESS = GET ( STREAMS, PREFIX )
	IF ( .NOT. LZ_COMPRESS ) RETURN
C
C	Main loop, get next character.
C
	DO WHILE ( GET ( STREAMS, CHAR ) )
C
C	    Lookup string PREFIX//CHAR
C
	    CALL LZ_LOOKUP_CODE ( PREFIX, CHAR, CODE, NEW )
	    IF ( NEW ) THEN
C
C		New entry was added.  output and reset prefix.  Lookup
C		routine automatically added new table entry.  Increment
C		OUT_BITS if new code is higher than can fit with current.
C
		LZ_COMPRESS = PUT ( OUT_BITS, STREAMS, PREFIX )
		IF ( .NOT. LZ_COMPRESS ) RETURN
		OUT_BITS = LZ_MAX_BIT ( OUT_BITS, CODE )
		PREFIX = CHAR
C
C		Perform reset if last code entered in table was max.
C		Since decompressor can't reset bit size until it reads
C		the clear, output the final code before table reset.
C
		IF ( CODE .GE. '7FF0'X ) CHAR = CLEAR_CODE
		IF ( CHAR .EQ. CLEAR_CODE ) THEN
		    LZ_COMPRESS = PUT ( OUT_BITS, STREAMS, PREFIX )
		    LZ_COMPRESS = PUT ( OUT_BITS, STREAMS, CLEAR_CODE )
		    CALL LZ_CLEAR_LOOKUP_TABLE ( MAX_CHAR )
		    OUT_BITS = LZ_MAX_BIT ( 1, MAX_CHAR )
		    LZ_COMPRESS = GET ( STREAMS, PREFIX )
		    IF ( .NOT. LZ_COMPRESS ) RETURN
		END IF
C
	    ELSE
C
C		We found existing code in the table, make that the prefix 
C		string.
C
		PREFIX = CODE
	    END IF
	END DO
C
C	Output final prefix character.
C
	LZ_COMPRESS = PUT ( OUT_BITS, STREAMS, PREFIX )
	END
C
	INTEGER FUNCTION LZ_DECOMPRESS ( GET, PUT, MAX_CHAR, 
	1	CLEAR_CODE, STREAMS )
C+
C	De-compress Lemel-Ziv encoded data.  Commenting isn't too good
C	because I blindly copied the algorithm from comments in the
C	LZCMP source code.
C
C	Author:	David Jones
C	Date:	20-AUG-1988
C
C	Input:
C	    GET		External.  Input routine, return input code.
C	    PUT		External.  Output routine.  Send output char.
C	    MAX_CHAR	Integer.  Maximum char value to be processed by PUT.
C	    CLEAR_CODE	Integer.  Code value for table reset.
C	    STREAMS	Structure.  Context for GET and PUT routines.
C-
	IMPLICIT NONE
	INTEGER GET, PUT, STREAMS(100), MAX_CHAR, CLEAR_CODE
	EXTERNAL GET, PUT
	INTEGER CODE, PREVIOUS_CODE, NEW_CODE, CHAR, FIRST_CHAR
	INTEGER IN_BITS, LZ_MAX_BIT, PREFIX, NEXT_PREFIX, LZ_GET_CODE_INFO
	LOGICAL CLEAR_PRESENT, NEW, SPECIAL
	INTEGER PTR, STACK(32768)
C
C	Initialize lookup table and compute initial input bit field size.
C
10	CALL LZ_CLEAR_LOOKUP_TABLE ( MAX_CHAR )
	IN_BITS = LZ_MAX_BIT ( 1, MAX_CHAR )
C
C	Read and output first code, which we assume is less or equal to 
C	MAX_CHAR.
C
	LZ_DECOMPRESS = GET ( IN_BITS, STREAMS, PREVIOUS_CODE )
	IF ( .NOT. LZ_DECOMPRESS ) RETURN 
	LZ_DECOMPRESS = PUT ( STREAMS, PREVIOUS_CODE )
	IF ( .NOT. LZ_DECOMPRESS ) RETURN
	FIRST_CHAR = PREVIOUS_CODE
C
C	Main loop.  Get and process input codes until we run out.
C
	DO WHILE ( GET ( IN_BITS, STREAMS, CODE ) )
C
C	    Perform reset if code read is CLEAR_CODE
C
	    IF ( CODE .EQ. CLEAR_CODE ) GOTO 10
C
C	    See if code exists in table, getting it's prefix code and
C	    suffix character in the process (suffix character is placed
C	    on stack).
C
	    PTR = 1
	    IF ( .NOT. LZ_GET_CODE_INFO(CODE, PREFIX, STACK(PTR)) ) THEN
C
C		CODE is not in table, this occurs if we have a K<w>K<w>k
C		sequence in the original input data.  It occurs because
C		we are really a step behind in re-contructing the string
C		table and the compressor used a code that it just added
C		(I think).  Generate the prefix code and suffix character 
C		appropriately the code will get added down below.
C
		PREFIX = PREVIOUS_CODE
		STACK(PTR) = FIRST_CHAR
	    END IF
C
C	    Translate prefix CODE into string of characters pushed on stack.
C
	    DO WHILE ( PREFIX .GE. 0 )
		PTR = PTR + 1
		CALL LZ_GET_CODE_INFO ( PREFIX, NEXT_PREFIX, STACK(PTR) )
		PREFIX = NEXT_PREFIX
	    END DO
C
C	    Save the first character to be output and dump the stack.
C
	    FIRST_CHAR = STACK(PTR)
	    DO WHILE ( PTR .GT. 0 )
		CALL PUT ( STREAMS, STACK(PTR) )
		PTR = PTR - 1
	    END DO
C
C	    Make new entry in string table using the previous character
C	    and the first chracter output from the current code.
C
	    CALL LZ_LOOKUP_CODE ( PREVIOUS_CODE, FIRST_CHAR, NEW_CODE, NEW )
	    IF ( NEW ) THEN
		IN_BITS = LZ_MAX_BIT ( IN_BITS, NEW_CODE+1 )
	    ELSE
		TYPE*,'/decompress/ attempt to insert duplicate:',
	1		PREVIOUS_CODE,FIRST_CHAR,NEW_CODE
	    END IF
	    PREVIOUS_CODE = CODE
C
	END DO
	END
C
C
	SUBROUTINE LZ_CLEAR_LOOKUP_TABLE ( MAX_CHAR )
C+
C**	    Subroutine LZ_CLEAR_LOOKUP_TABLE
C	Initialize code lookup table.  The caller specifies how many
C	codes above 255 are to be reserved for special functions.
C
C	Input:
C	    MAX_CHAR	Number of reserved character codes for lookup.  
C			Code values at or below MAX_CHAR are considered
C			to be encodings for single character strings.
C	Implicit Output:
C	    /LZ_TABLE/ common block.
C-
	IMPLICIT NONE
	INTEGER MAX_CHAR
	INTEGER I
C
C	Define structures for lookup table and place in common block.
C
	INTEGER MAX_CODE
	INTEGER*2 HASH_TABLE(0:32767)
	STRUCTURE /TABLE/
	    INTEGER*2 PREFIX			! prefix code
	    INTEGER*2 CHAR			! trailing character
	    INTEGER*2 NXT_HASH			! next code that hashed to
						! same value, end by self-code.
	END STRUCTURE
	RECORD /TABLE/ TABLE(0:32767)
	COMMON /LZ_TABLE/ MAX_CODE, TABLE, HASH_TABLE
C
C	Initialize HASH_TABLE, we can use zero to mark as empty since
C	only entries above the initial 256 will be entered.
C
	DO I = 0, 32767
	    HASH_TABLE(I) = 0
	END DO
C
C	Initialize code table.
C
	MAX_CODE = MAX_CHAR
	DO I = 0, MAX_CODE
	    TABLE(I).PREFIX = -1		! assume preceded by nothing
	    TABLE(I).CHAR = I
	    TABLE(I).NXT_HASH = 0
	END DO
	END
C
	SUBROUTINE CHECK_TABLE ( MAX_CHAR )
C
C	Check table for duplicates
C
	IMPLICIT NONE
	INTEGER MAX_CHAR
	INTEGER I, J
C
C	Define structures for lookup table and place in common block.
C
	INTEGER MAX_CODE
	INTEGER*2 HASH_TABLE(0:32767)
	STRUCTURE /TABLE/
	    INTEGER*2 PREFIX			! prefix code
	    INTEGER*2 CHAR			! trailing character
	    INTEGER*2 NXT_HASH			! next code that hashed to
						! same value, end by self-code.
	END STRUCTURE
	RECORD /TABLE/ TABLE(0:32767)
	COMMON /LZ_TABLE/ MAX_CODE, TABLE, HASH_TABLE
C
	IF ( MAX_CHAR .NE. -8455 ) RETURN
	TYPE*,'/table/ verifing table'
	DO I = MAX_CHAR+1, MAX_CODE - 1
	    DO J = I + 1, MAX_CODE
		IF ( TABLE(I).PREFIX .EQ. TABLE(J).PREFIX .AND.
	1	     TABLE(I).CHAR .EQ. TABLE(J).CHAR ) THEN
		    TYPE*,'/table/ duplicate pair:', I, J, 
	1		TABLE(J).PREFIX, TABLE(J).CHAR
		END IF
	    END DO
	END DO
	END
C
	SUBROUTINE LZ_LOOKUP_CODE ( PREFIX, CHAR, CODE, NEW )
C+
C**	    Subroutine LZ_LOOKUP_CODE
C	See if the combination of PREFIX and CHAR is in the lookup table,
C	and return its code value.  Otherwise make new entry in the lookup
C	table and return the created code value
C
C	Input:
C	    PREFIX	Integer.  Previous code value entered into table.
C	    CHAR	Integer.  Value from 0-255 representing next data
C			byte.
C	Output:
C	    CODE	Integer.  Output code value for PREFIX//CHAR combin.
C	    NEW		Logical.  Set true iff CODE was added to the table
C			this call.
C-
	IMPLICIT NONE
	INTEGER PREFIX, CHAR, CODE, NEW
	INTEGER HASH, PTR, T, LAST_PTR
C
C	Define structures for lookup table and place in common block.
C
	INTEGER MAX_CODE
	INTEGER*2 HASH_TABLE(0:32767)
	STRUCTURE /TABLE/
	    INTEGER*2 PREFIX			! prefix code
	    INTEGER*2 CHAR			! trailing character
	    INTEGER*2 NXT_HASH			! next code that hashed to
						! same value, end by self-code.
	END STRUCTURE
	RECORD /TABLE/ TABLE(0:32767)
	COMMON /LZ_TABLE/ MAX_CODE, TABLE, HASH_TABLE
	INTEGER STACK_PTR, I
	INTEGER*2 STACK(33000)
C
C	Hash the prefix and code.  Try to get good locality on hash table.
C
	HASH = IAND ( IEOR ( PREFIX, ISHFT ( CHAR, 7 ) ), 32767 )
	PTR = HASH_TABLE(HASH)
	LAST_PTR = 0
C
C	Try to locate the combination of prefix and char by searching the
C	hash chain.
C
	DO WHILE ( PTR .NE. 0 )
	    IF ( TABLE(PTR).PREFIX .EQ. PREFIX .AND.
	1	 TABLE(PTR).CHAR .EQ. CHAR ) THEN
C
C		Code found in table, return it.
C
		CODE = PTR
		NEW = .FALSE.
		RETURN
C
	    ELSE
C
C		Try next code.
C
		LAST_PTR = PTR
		PTR = TABLE(PTR).NXT_HASH
	    END IF
	END DO
C
C	falling through loop means entry not found, create new one.
C	Insert the new entry at end of hash chain.
C
	MAX_CODE = MAX_CODE + 1
	TABLE(MAX_CODE).PREFIX = PREFIX
	TABLE(MAX_CODE).CHAR = CHAR
	TABLE(MAX_CODE).NXT_HASH = 0
	IF ( LAST_PTR .EQ. 0 ) THEN	! First entry in hash chain
	    HASH_TABLE(HASH) = MAX_CODE
	ELSE
	    TABLE(LAST_PTR).NXT_HASH = MAX_CODE
	END IF
C
C	Return new entry's index to caller.
C
	CODE = MAX_CODE
	NEW = .TRUE.
C
	END
C
C
	INTEGER FUNCTION LZ_GET_CODE_INFO ( CODE, PREFIX, CHAR )
C+
C**	    Routine LZ_GET_CODE_INFO
C	Return lookup table information for a specific code.
C
C	Return value:
C	    1		Success.
C	    0		Code does not exist in table.
C	Input:
C	    CODE	Integer.
C	Output:
C	    PREFIX	Integer.  Previous code value entered into table.
C	    CHAR	Integer.  Value from 0-255 representing next data
C			byte.
C-
	IMPLICIT NONE
	INTEGER PREFIX, CHAR, CODE
C
C	Define structures for lookup table and place in common block.
C
	INTEGER MAX_CODE
	INTEGER*2 HASH_TABLE(0:32767)
	STRUCTURE /TABLE/
	    INTEGER*2 PREFIX			! prefix code
	    INTEGER*2 CHAR			! trailing character
	    INTEGER*2 NXT_HASH			! next code that hashed to
						! same value, end by self-code.
	END STRUCTURE
	RECORD /TABLE/ TABLE(0:32767)
	COMMON /LZ_TABLE/ MAX_CODE, TABLE, HASH_TABLE
C
C	Simply retrieve the info and return
C
	IF ( CODE .LE. MAX_CODE ) THEN
	    PREFIX = TABLE(CODE).PREFIX
	    CHAR = TABLE(CODE).CHAR
	    LZ_GET_CODE_INFO = 1
	    RETURN
	ELSE
	    LZ_GET_CODE_INFO = 0
	    RETURN
	END IF
C
	END
