Contributor: ANDREW EIGUS
Unit LZSSUnit;
{
LZSSUNIT - Compress and uncompress unit using LZ77 algorithm for
Borland (Turbo) Pascal version 7.0.
Assembler Programmer: Andy Tam, Pascal Conversion: Douglas Webb,
Unit Conversion and Dynamic Memory Allocation: Andrew Eigus.
Public Domain version 1.02, last changed on 30.11.94.
Target platforms: DOS, DPMI, Windows.
Written by Andrew Eigus (aka: Mr. Byte) of:
Fidonet: 2:5100/33,
Internet: aeigus@fgate.castle.riga.lv, aeigus@kristin.cclu.lv.
}
interface
{#Z+}
{ This unit is ready for use with Dj. Murdoch's ScanHelp utility which
will make a Borland .TPH file for it. }
{#Z-}
const
LZRWBufSize = 8192; { Read buffer size }
{#Z+}
N = 4096; { Bigger N -> Better compression on big files only. }
F = 18;
Threshold = 2;
Nul = N * 2;
InBufPtr : word = LZRWBufSize;
InBufSize : word = LZRWBufSize;
OutBufPtr : word = 0;
{#Z-}
type
{#X TWriteProc}{#X LZSquash}{#X LZUnsquash}
TReadProc = function(var ReadBuf; var NumRead : word) : word;
{ This is declaration for custom read function. It should read
#LZRWBufSize# bytes from ReadBuf. The return value is ignored. }
{#X TReadProc}{#X LZSquash}{#X LZUnsquash}
TWriteProc = function(var WriteBuf; Count : word; var NumWritten : word) :
word; { This is declaration for custom write function. It should write
Count bytes into WriteBuf and return number of actual bytes written
into NumWritten variable. The return value is ignored. }
{#Z+}
PLZRWBuffer = ^TLZRWBuffer;
TLZRWBuffer = array[0..LZRWBufSize - 1] of Byte; { file buffers }
PLZTextBuf = ^TLZTextBuf;
TLZTextBuf = array[0..N + F - 2] of Byte;
PLeftMomTree = ^TLeftMomTree;
TLeftMomTree = array[0..N] of Word;
PRightTree = ^TRightTree;
TRightTree = array[0..N + 256] of Word;
const
LZSSMemRequired = SizeOf(TLZRWBuffer) * 2 +
SizeOf(TLZTextBuf) + SizeOf(TLeftMomTree) * 2 + SizeOf(TRightTree);
{#Z-}
function LZInit : boolean;
{ This function should be called before any other compression routines
from this unit - it allocates memory and initializes all internal
variables required by compression procedures. If allocation fails,
LZInit returns False, this means that there isn't enough memory for
compression or decompression process. It returns True if initialization
was successful. }
{#X LZDone}{#X LZSquash}{#X LZUnsquash}
procedure LZSquash(ReadProc : TReadProc; WriteProc : TWriteProc);
{ This procedure is used for compression. ReadProc specifies custom
read function that reads data, and WriteProc specifies custom write
function that writes compressed data. }
{#X LZUnsquash}{#X LZInit}{#X LZDone}
procedure LZUnSquash(ReadProc : TReadProc; WriteProc : TWriteProc);
{ This procedure is used for decompression. ReadProc specifies custom
read function that reads compressed data, and WriteProc specifies
custom write function that writes decompressed data. }
{#X LZSquash}{#X LZInit}{#X LZDone}
procedure LZDone;
{ This procedure should be called after you finished compression or
decompression. It deallocates (frees) all memory allocated by LZInit.
Note: You should always call LZDone after you finished using compression
routines from this unit. }
{#X LZInit}{#X LZSquash}{#X LZUnsquash}
implementation
var
Height, MatchPos, MatchLen, LastLen : word;
TextBufP : PLZTextBuf;
LeftP, MomP : PLeftMomTree;
RightP : PRightTree;
CodeBuf : array[0..16] of Byte;
LZReadProc : TReadProc;
LZWriteProc : TWriteProc;
InBufP, OutBufP : PLZRWBuffer;
Bytes : word;
Initialized : boolean;
Function LZSS_Read : word; { Returns # of bytes read }
Begin
LZReadProc(InBufP^, Bytes);
LZSS_Read := Bytes;
End; { LZSS_Read }
Function LZSS_Write : word; { Returns # of bytes written }
Begin
LZWriteProc(OutBufP^, OutBufPtr, Bytes);
LZSS_Write := Bytes
End; { LZSS_Write }
Procedure Getc; assembler;
Asm
{
getc : return a character from the buffer
RETURN : AL = input char
Carry set when EOF
}
push bx
mov bx, inBufPtr
cmp bx, inBufSize
jb @getc1
push cx
push dx
push di
push si
call LZSS_Read
pop si
pop di
pop dx
pop cx
mov inBufSize, ax
or ax, ax
jz @getc2 { ; EOF }
xor bx, bx
@getc1:
PUSH DI
LES DI,[InBufP]
MOV AL,BYTE PTR [ES:DI+BX]
POP DI
inc bx
mov inBufPtr, bx
pop bx
clc { ; clear the carry flag }
jmp @end
@getc2: pop bx
stc { ; set carry to indicate EOF }
@end:
End; { Getc }
Procedure Putc; assembler;
{
putc : put a character into the output buffer
Entry : AL = output char
}
Asm
push bx
mov bx, outBufPtr
PUSH DI
LES DI,[OutBufP]
MOV BYTE PTR [ES:DI+BX],AL
POP DI
inc bx
cmp bx, LZRWBufSize
jb @putc1
mov OutBufPtr,LZRWBufSize { Just so the flush will work. }
push cx
push dx
push di
push si
call LZSS_Write
pop si
pop di
pop dx
pop cx
xor bx, bx
@putc1: mov outBufPtr, bx
pop bx
End; { Putc }
Procedure InitTree; assembler;
{
initTree : initialize all binary search trees. There are 256 BST's, one
for all strings started with a particular character. The
parent is tree K is the node N + K + 1 and it has only a
right child
}
Asm
cld
push ds
pop es
LES DI,[RightP]
{ mov di,offset right}
add di, (N + 1) * 2
mov cx, 256
mov ax, NUL
rep stosw
LES DI,[MomP]
{ mov di, offset mom}
mov cx, N
rep stosw
End; { InitTree }
Procedure Splay; assembler;
{
splay : use splay tree operations to move the node to the 'top' of
tree. Note that it will not actual become the root of the tree
because the root of each tree is a special node. Instead, it
will become the right child of this special node.
ENTRY : di = the node to be rotated
}
Asm
@Splay1:
PUSH BX
LES BX,[MomP]
MOV SI,[ES:BX+DI]
POP BX
{ mov si, [Offset Mom + di]}
cmp si, NUL { ; exit if its parent is a special
node } ja @Splay4
PUSH DI
LES DI,[MomP]
ADD DI,SI
MOV BX,[ES:DI]
{ mov bx, [Offset Mom + si]}
POP DI
cmp bx, NUL { ; check if its grandparent is special
} jbe @Splay5 { ; if not then skip }
PUSH BX
LES BX,[LeftP]
CMP DI,[ES:BX+SI]
POP BX
{ cmp di, [Offset Left + si]} { ; is the current node is a
left child ? } jne @Splay2
PUSH BX
LES BX,[RightP]
MOV DX,[ES:BX+DI]
{ mov dx, [Offset Right + di]} { ; perform a left zig
operation } LES BX,[LeftP]
MOV [ES:BX+SI],DX
{ mov [Offset Left + si], dx}
LES BX,[RightP]
MOV [ES:BX+DI],SI
POP BX
{ mov [Offset Right + di], si}
jmp @Splay3
@Splay2:
PUSH BX
LES BX,[LeftP]
MOV DX,[ES:BX+DI]
{ mov dx, [Offset Left + di]} { ; perform a right zig }
LES BX,[RightP]
MOV [ES:BX+SI],DX
{ mov [Offset Right + si], dx}
LES BX,[LeftP]
MOV [ES:BX+DI],SI
POP BX
{ mov [Offset Left + di], si}
@Splay3:
PUSH SI
LES SI,[RightP]
MOV [ES:SI+BX],DI
POP SI
{ mov [Offset Right + bx], di}
xchg bx, dx
PUSH AX
MOV AX,BX
LES BX,[MomP]
ADD BX,AX
MOV [ES:BX],SI
LES BX,[MomP]
MOV [ES:BX+SI],DI
LES BX,[MomP]
MOV [ES:BX+DI],DX
MOV BX,AX
POP AX
{ mov [Offset Mom + bx], si
mov [Offset Mom + si], di
mov [Offset Mom + di], dx}
@Splay4: jmp @end
@Splay5:
PUSH DI
LES DI,[MomP]
MOV CX,[ES:DI+BX]
POP DI
{ mov cx, [Offset Mom + bx]}
PUSH BX
LES BX,[LeftP]
CMP DI,[ES:BX+SI]
POP BX
{ cmp di, [Offset Left + si]}
jne @Splay7
PUSH DI
LES DI,[LeftP]
CMP SI,[ES:DI+BX]
POP DI
{ cmp si, [Offset Left + bx]}
jne @Splay6
PUSH AX
MOV AX,DI
LES DI,[RightP]
ADD DI,SI
MOV DX,[ES:DI]
{ mov dx, [Offset Right + si] } { ; perform a left zig-zig
operation } LES DI,[LeftP]
MOV [ES:DI+BX],DX
{ mov [Offset Left + bx], dx}
xchg bx, dx
LES DI,[MomP]
MOV [ES:DI+BX],DX
{ mov [Offset Mom + bx], dx}
LES DI,[RightP]
ADD DI,AX
MOV BX,[ES:DI]
{ mov bx, [Offset Right + di]}
LES DI,[LeftP]
ADD DI,SI
MOV [ES:DI],BX
LES DI,[MomP]
MOV [ES:DI+BX],SI
{ mov [Offset Left +si], bx
mov [Offset Mom + bx], si}
mov bx, dx
LES DI,[RightP]
ADD DI,SI
MOV [ES:DI],BX
LES DI,[RightP]
ADD DI,AX
MOV [ES:DI],SI
{ mov [Offset Right + si], bx
mov [Offset Right + di], si}
LES DI,[MomP]
MOV [ES:DI+BX],SI
LES DI,[MomP]
ADD DI,SI
STOSW
MOV DI,AX
POP AX
{ mov [Offset Mom + bx], si
mov [Offset Mom + si], di}
jmp @Splay9
@Splay6:
PUSH AX
MOV AX,SI
LES SI,[LeftP]
ADD SI,DI
MOV DX,[ES:SI]
{ mov dx, [Offset Left + di]} { ; perform a left zig-zag
operation } LES SI,[RightP]
MOV [ES:SI+BX],DX
{ mov [Offset Right + bx], dx}
xchg bx, dx
LES SI,[MomP]
MOV [ES:SI+BX],DX
{ mov [Offset Mom + bx], dx}
LES SI,[RightP]
ADD SI,DI
MOV BX,[ES:SI]
{ mov bx, [Offset Right + di]}
LES SI,[LeftP]
ADD SI,AX
MOV [ES:SI],BX
{ mov [Offset Left + si], bx}
LES SI,[MomP]
MOV [ES:SI+BX],AX
{ mov [Offset Mom + bx], si}
mov bx, dx
LES SI,[LeftP]
ADD SI,DI
MOV [ES:SI],BX
{ mov [Offset Left + di], bx}
LES SI,[RightP]
ADD SI,DI
MOV [ES:SI],AX
{ mov [Offset Right + di], si}
LES SI,[MomP]
ADD SI,AX
MOV [ES:SI],DI
{ mov [Offset Mom + si], di}
LES SI,[MomP]
MOV [ES:SI+BX],DI
MOV SI,AX
POP AX
{ mov [Offset Mom + bx], di}
jmp @Splay9
@Splay7:
PUSH DI
LES DI,[RightP]
CMP SI,[ES:DI+BX]
POP DI
{ cmp si, [Offset Right + bx]}
jne @Splay8
PUSH AX
MOV AX,SI
LES SI,[LeftP]
ADD SI,AX
MOV DX,[ES:SI]
{ mov dx, [Offset Left + si]} { ; perform a right zig-zig
} LES SI,[RightP]
MOV [ES:SI+BX],DX
{ mov [Offset Right + bx], dx}
xchg bx, dx
LES SI,[MomP]
MOV [ES:SI+BX],DX
{ mov [Offset Mom + bx], dx}
LES SI,[LeftP]
ADD SI,DI
MOV BX,[ES:SI]
{ mov bx, [Offset Left + di]}
LES SI,[RightP]
ADD SI,AX
MOV [ES:SI],BX
{ mov [Offset Right + si], bx}
LES SI,[MomP]
MOV [ES:SI+BX],AX
{ mov [Offset Mom + bx], si}
mov bx, dx
LES SI,[LeftP]
ADD SI,AX
MOV [ES:SI],BX
{ mov [Offset Left + si], bx}
LES SI,[LeftP]
ADD SI,DI
MOV [ES:SI],AX
{ mov [Offset Left + di], si}
LES SI,[MomP]
MOV [ES:SI+BX],AX
{ mov [Offset Mom + bx], si}
LES SI,[MomP]
ADD SI,AX
MOV [ES:SI],DI
{ mov [Offset Mom + si], di}
MOV SI,AX
POP AX
jmp @Splay9
@Splay8:
PUSH AX
MOV AX,SI
LES SI,[RightP]
ADD SI,DI
MOV DX,[ES:SI]
{ mov dx, [Offset Right + di]} { ; perform a right zig-zag
} LES SI,[LeftP]
MOV [ES:SI+BX],DX
{ mov [Offset Left + bx], dx}
xchg bx, dx
LES SI,[MomP]
MOV [ES:SI+BX],DX
{ mov [Offset Mom + bx], dx}
LES SI,[LeftP]
ADD SI,DI
MOV BX,[ES:SI]
{ mov bx, [Offset Left + di]}
LES SI,[RightP]
ADD SI,AX
MOV [ES:SI],BX
{ mov [Offset Right + si], bx}
LES SI,[MomP]
MOV [ES:SI+BX],AX
{ mov [Offset Mom + bx], si}
mov bx, dx
LES SI,[RightP]
ADD SI,DI
MOV [ES:SI],BX
{ mov [Offset Right + di], bx}
LES SI,[LeftP]
ADD SI,DI
MOV [ES:SI],AX
{ mov [Offset Left + di], si}
LES SI,[MomP]
ADD SI,AX
MOV [ES:SI],DI
LES SI,[MomP]
MOV [ES:SI+BX],DI
{ mov [Offset Mom + si], di
mov [Offset Mom + bx], di}
MOV SI,AX
POP AX
@Splay9: mov si, cx
cmp si, NUL
ja @Splay10
PUSH DI
LES DI,[LeftP]
ADD DI,SI
CMP BX,[ES:DI]
POP DI
{ cmp bx, [Offset Left + si]}
jne @Splay10
PUSH BX
LES BX,[LeftP]
MOV [ES:BX+SI],DI
POP BX
{ mov [Offset Left + si], di}
jmp @Splay11
@Splay10:
PUSH BX
LES BX,[RightP]
MOV [ES:BX+SI],DI
POP BX
{ mov [Offset Right + si], di}
@Splay11:
PUSH BX
LES BX,[MomP]
MOV [ES:BX+DI],SI
POP BX
{ mov [Offset Mom + di], si}
jmp @Splay1
@end:
End; { SPlay }
Procedure InsertNode; assembler;
{
insertNode : insert the new node to the corresponding tree. Note that the
position of a string in the buffer also served as the node
number.
ENTRY : di = position in the buffer
}
Asm
push si
push dx
push cx
push bx
mov dx, 1
xor ax, ax
mov matchLen, ax
mov height, ax
LES SI,[TextBufP]
ADD SI,DI
MOV AL,BYTE PTR [ES:SI]
{ mov al, byte ptr [Offset TextBuf + di]}
shl di, 1
add ax, N + 1
shl ax, 1
mov si, ax
mov ax, NUL
PUSH BX
LES BX,[RightP]
MOV WORD PTR [ES:BX+DI],AX
{ mov word ptr [Offset Right + di], ax}
LES BX,[LeftP]
MOV WORD PTR [ES:BX+DI],AX
POP BX
{ mov word ptr [Offset Left + di], ax}
@Ins1:inc height
cmp dx, 0
jl @Ins3
PUSH DI
LES DI,[RightP]
ADD DI,SI
MOV AX,WORD PTR [ES:DI]
POP DI
{ mov ax, word ptr [Offset Right + si]}
cmp ax, NUL
je @Ins2
mov si, ax
jmp @Ins5
@Ins2:
PUSH BX
LES BX,[RightP]
MOV WORD PTR [ES:BX+SI],DI
{ mov word ptr [Offset Right + si], di}
LES BX,[MomP]
MOV WORD PTR [ES:BX+DI],SI
POP BX
{ mov word ptr [Offset Mom + di], si}
jmp @Ins11
@Ins3:
PUSH BX
LES BX,[LeftP]
ADD BX,SI
MOV AX,WORD PTR [ES:BX]
POP BX
{ mov ax, word ptr [Offset Left + si]}
cmp ax, NUL
je @Ins4
mov si, ax
jmp @Ins5
@Ins4:
PUSH BX
LES BX,[LeftP]
ADD BX,SI
MOV WORD PTR [ES:BX],DI
{ mov word ptr [Offset Left + si], di}
LES BX,[MomP]
ADD BX,DI
MOV WORD PTR [ES:BX],SI
POP BX
{ mov word ptr [Offset Mom + di], si}
jmp @Ins11
@Ins5: mov bx, 1
shr si, 1
shr di, 1
xor ch, ch
xor dh, dh
@Ins6:
PUSH SI
LES SI,[TextBufP]
ADD SI,DI
MOV DL,BYTE PTR [ES:SI+BX]
POP SI
PUSH DI
LES DI,[TextBufP]
ADD DI,SI
MOV CL,BYTE PTR [ES:DI+BX]
POP DI
{ mov dl, byte ptr [Offset Textbuf + di + bx]
mov cl, byte ptr [Offset TextBuf + si + bx]}
sub dx, cx
jnz @Ins7
inc bx
cmp bx, F
jb @Ins6
@Ins7: shl si, 1
shl di, 1
cmp bx, matchLen
jbe @Ins1
mov ax, si
shr ax, 1
mov matchPos, ax
mov matchLen, bx
cmp bx, F
jb @Ins1
@Ins8:
PUSH CX
LES BX,[MomP]
MOV AX,WORD PTR [ES:BX+SI]
{ mov ax, word ptr [Offset Mom + si]}
LES BX,[MomP]
MOV WORD PTR [ES:BX+DI],AX
{ mov word ptr [Offset Mom + di], ax}
LES BX,[LeftP]
MOV CX,WORD PTR [ES:BX+SI]
{ mov bx, word ptr [Offset Left + si]}
LES BX,[LeftP]
MOV WORD PTR [ES:BX+DI],CX
{ mov word ptr [Offset Left + di], bx}
LES BX,[MomP]
ADD BX,CX
MOV WORD PTR [ES:BX],DI
{ mov word ptr [Offset Mom + bx], di}
LES BX,[RightP]
MOV CX,WORD PTR [ES:BX+SI]
{ mov bx, word ptr [Offset Right + si]}
LES BX,[RightP]
MOV WORD PTR [ES:BX+DI],CX
{ mov word ptr [Offset Right + di], bx}
LES BX,[MomP]
ADD BX,CX
MOV WORD PTR [ES:BX],DI
{ mov word ptr [Offset Mom + bx], di}
LES BX,[MomP]
MOV CX,WORD PTR [ES:BX+SI]
{ mov bx, word ptr [Offset Mom + si]}
MOV BX,CX
POP CX
PUSH DI
LES DI,[RightP]
CMP SI,WORD PTR [ES:DI+BX]
POP DI
{ cmp si, word ptr [Offset Right + bx]}
jne @Ins9
PUSH SI
LES SI,[RightP]
MOV WORD PTR [ES:SI+BX],DI
POP SI
{ mov word ptr [Offset Right + bx], di}
jmp @Ins10
@Ins9:
PUSH SI
LES SI,[LeftP]
MOV WORD PTR [ES:SI+BX],DI
POP SI
{ mov word ptr [Offset Left + bx], di}
@Ins10:
PUSH DI
LES DI,[MomP]
ADD DI,SI
MOV WORD PTR [ES:DI],NUL
POP DI
{ mov word ptr [Offset Mom + si], NUL}
@Ins11: cmp height, 30
jb @Ins12
call Splay
@Ins12: pop bx
pop cx
pop dx
pop si
shr di, 1
End; { InsertNode }
Procedure DeleteNode; assembler;
{
deleteNode : delete the node from the tree
ENTRY : SI = position in the buffer
}
Asm
push di
push bx
shl si, 1
PUSH DI
LES DI,[MomP]
ADD DI,SI
CMP WORD PTR [ES:DI],NUL
POP DI
{ cmp word ptr [Offset Mom + si], NUL} { ; if it has no
parent then exit } je @del7
PUSH DI
LES DI,[RightP]
ADD DI,SI
CMP WORD PTR [ES:DI],NUL
POP DI
{ cmp word ptr [Offset Right + si], NUL} { ; does it have
right child ? } je @del8
PUSH BX
LES BX,[LeftP]
MOV DI,WORD PTR [ES:BX+SI]
POP BX
{ mov di, word ptr [Offset Left + si] } { ; does it have left
child ? } cmp di, NUL
je @del9
PUSH SI
LES SI,[RightP]
ADD SI,DI
MOV AX,WORD PTR [ES:SI]
POP SI
{ mov ax, word ptr [Offset Right + di]} { ; does it have
right grandchild ? } cmp ax, NUL
je @del2 { ; if no then skip }
@del1: mov di, ax { ; find the rightmost
node in } PUSH SI
LES SI,[RightP]
ADD SI,DI
MOV AX,WORD PTR [ES:SI]
POP SI
{ mov ax, word ptr [Offset Right + di] } { ; the right
subtree } cmp ax, NUL
jne @del1
PUSH CX
MOV CX,SI
LES SI,[MomP]
ADD SI,DI
MOV BX,WORD PTR [ES:SI]
{ mov bx, word ptr [Offset Mom + di] } { ; move this node as
the root of } LES SI,[LeftP]
ADD SI,DI
MOV AX,WORD PTR [ES:SI]
{ mov ax, word ptr [Offset Left + di]} { ; the subtree }
LES SI,[RightP]
MOV WORD PTR [ES:SI+BX],AX
{ mov word ptr [Offset Right + bx], ax}
xchg ax, bx
LES SI,[MomP]
MOV WORD PTR [ES:SI+BX],AX
{ mov word ptr [Offset Mom + bx], ax}
LES SI,[LeftP]
ADD SI,CX
MOV BX,WORD PTR [ES:SI]
{ mov bx, word ptr [Offset Left + si]}
LES SI,[LeftP]
ADD SI,DI
MOV WORD PTR [ES:SI],BX
{ mov word ptr [Offset Left + di], bx}
LES SI,[MomP]
MOV WORD PTR [ES:SI+BX],DI
{ mov word ptr [Offset Mom + bx], di}
MOV SI,CX
POP CX
@del2:
PUSH CX
MOV CX,SI
LES SI,[RightP]
ADD SI,CX
MOV BX,WORD PTR [ES:SI]
{ mov bx, word ptr [Offset Right + si]}
LES SI,[RightP]
ADD SI,DI
MOV WORD PTR [ES:SI],BX
{ mov word ptr [Offset Right + di], bx}
LES SI,[MomP]
MOV WORD PTR [ES:SI+BX],DI
MOV SI,CX
POP CX
{ mov word ptr [Offset Mom + bx], di}
@del3:
PUSH CX
MOV CX,DI
LES DI,[MomP]
ADD DI,SI
MOV BX,WORD PTR [ES:DI]
{ mov bx, word ptr [Offset Mom + si]}
LES DI,[MomP]
ADD DI,CX
MOV WORD PTR [ES:DI],BX
{ mov word ptr [Offset Mom + di], bx}
MOV DI,CX
POP CX
PUSH DI
LES DI,[RightP]
CMP SI,WORD PTR [ES:DI+BX]
POP DI
{ cmp si, word ptr [Offset Right + bx]}
jne @del4
PUSH SI
LES SI,[RightP]
MOV WORD PTR [ES:SI+BX],DI
POP SI
{ mov word ptr [Offset Right + bx], di}
jmp @del5
@del4:
PUSH SI
LES SI,[LeftP]
MOV WORD PTR [ES:SI+BX],DI
POP SI
{ mov word ptr [Offset Left + bx], di}
@del5:
PUSH DI
LES DI,[MomP]
ADD DI,SI
MOV WORD PTR [ES:DI],NUL
POP DI
{ mov word ptr [Offset Mom + si], NUL}
@del7: pop bx
pop di
shr si, 1
jmp @end;
@del8:
PUSH BX
LES BX,[LeftP]
MOV DI,WORD PTR [ES:BX+SI]
POP BX
{ mov di, word ptr [Offset Left + si]}
jmp @del3
@del9:
PUSH BX
LES BX,[RightP]
MOV DI,WORD PTR [ES:BX+SI]
POP BX
{ mov di, word ptr [Offset Right + si]}
jmp @del3
@end:
End; { DeleteNode }
Procedure Encode; assembler;
Asm
call initTree
xor bx, bx
mov [Offset CodeBuf + bx], bl
mov dx, 1
mov ch, dl
xor si, si
mov di, N - F
@Encode2: call getc
jc @Encode3
PUSH SI
LES SI,[TextBufP]
ADD SI,DI
MOV BYTE PTR [ES:SI+BX],AL
POP SI
{ mov byte ptr [Offset TextBuf +di + bx], al}
inc bx
cmp bx, F
jb @Encode2
@Encode3: or bx, bx
jne @Encode4
jmp @Encode19
@Encode4: mov cl, bl
mov bx, 1
push di
sub di, 1
@Encode5: call InsertNode
inc bx
dec di
cmp bx, F
jbe @Encode5
pop di
call InsertNode
@Encode6: mov ax, matchLen
cmp al, cl
jbe @Encode7
mov al, cl
mov matchLen, ax
@Encode7: cmp al, THRESHOLD
ja @Encode8
mov matchLen, 1
or byte ptr codeBuf, ch
mov bx, dx
PUSH SI
LES SI,[TextBufP]
ADD SI,DI
MOV AL,BYTE PTR [ES:SI]
POP SI
{ mov al, byte ptr [Offset TextBuf + di]}
mov byte ptr [Offset CodeBuf + bx], al
inc dx
jmp @Encode9
@Encode8: mov bx, dx
mov al, byte ptr matchPos
mov byte ptr [Offset Codebuf + bx], al
inc bx
mov al, byte ptr (matchPos + 1)
push cx
mov cl, 4
shl al, cl
pop cx
mov ah, byte ptr matchLen
sub ah, THRESHOLD + 1
add al, ah
mov byte ptr [Offset Codebuf + bx], al
inc bx
mov dx, bx
@Encode9: shl ch, 1
jnz @Encode11
xor bx, bx
@Encode10: mov al, byte ptr [Offset CodeBuf + bx]
call putc
inc bx
cmp bx, dx
jb @Encode10
mov dx, 1
mov ch, dl
mov byte ptr codeBuf, dh
@Encode11: mov bx, matchLen
mov lastLen, bx
xor bx, bx
@Encode12: call getc
{ jc @Encode14}
jc @Encode15
push ax
call deleteNode
pop ax
PUSH DI
LES DI,[TextBufP]
ADD DI,SI
stosb
POP DI
{ mov byte ptr [Offset TextBuf + si], al}
cmp si, F - 1
jae @Encode13
PUSH DI
LES DI,[TextBufP]
ADD DI,SI
MOV BYTE PTR [ES:DI+N],AL
POP DI
{ mov byte ptr [Offset TextBuf + si + N], al}
@Encode13: inc si
and si, N - 1
inc di
and di, N - 1
call insertNode
inc bx
cmp bx, lastLen
jb @Encode12
(* @Encode14: sub printCount, bx
jnc @Encode15
mov ax, printPeriod
mov printCount, ax
push dx { Print out a period as a sign. }
mov dl, DBLARROW
mov ah, 2
int 21h
pop dx *)
@Encode15: cmp bx, lastLen
jae @Encode16
inc bx
call deleteNode
inc si
and si, N - 1
inc di
and di, N - 1
dec cl
jz @Encode15
call insertNode
jmp @Encode15
@Encode16: cmp cl, 0
jbe @Encode17
jmp @Encode6
@Encode17: cmp dx, 1
jb @Encode19
xor bx, bx
@Encode18: mov al, byte ptr [Offset Codebuf + bx]
call putc
inc bx
cmp bx, dx
jb @Encode18
@Encode19:
End; { Encode }
Procedure Decode; assembler;
Asm
xor dx, dx
mov di, N - F
@Decode2: shr dx, 1
or dh, dh
jnz @Decode3
call getc
jc @Decode9
mov dh, 0ffh
mov dl, al
@Decode3: test dx, 1
jz @Decode4
call getc
jc @Decode9
PUSH SI
LES SI,[TextBufP]
ADD SI,DI
MOV BYTE PTR [ES:SI],AL
POP SI
{ mov byte ptr [Offset TextBuf + di], al}
inc di
and di, N - 1
call putc
jmp @Decode2
@Decode4: call getc
jc @Decode9
mov ch, al
call getc
jc @Decode9
mov bh, al
mov cl, 4
shr bh, cl
mov bl, ch
mov cl, al
and cl, 0fh
add cl, THRESHOLD
inc cl
@Decode5: and bx, N - 1
PUSH SI
LES SI,[TextBufP]
MOV AL,BYTE PTR [ES:SI+BX]
ADD SI,DI
MOV BYTE PTR [ES:SI],AL
POP SI
{ mov al, byte ptr [Offset TextBuf + bx]
mov byte ptr [Offset TextBuf + di], al}
inc di
and di, N - 1
call putc
inc bx
dec cl
jnz @Decode5
jmp @Decode2
@Decode9:
End; { Decode }
Function LZInit : boolean;
Begin
if Initialized then Exit;
LZInit := False;
New(InBufP);
New(OutBufP);
New(TextBufP);
New(LeftP);
New(MomP);
New(RightP);
Initialized := (InBufP nil) and (OutBufP nil) and
(TextBufP nil) and (LeftP nil) and (MomP nil) and (RightP nil);
if Initialized then LZInit := True else
begin
Initialized := True;
LZDone
end
End; { LZInit }
Procedure LZDone;
Begin
if Initialized then
begin
Dispose(InBufP);
Dispose(OutBufP);
Dispose(RightP);
Dispose(MomP);
Dispose(LeftP);
Dispose(TextBufP);
Initialized := False
end
End; { LZDone }
Procedure LZSquash;
Begin
if Initialized then
begin
InBufPtr := LZRWBufSize;
InBufSize := LZRWBufSize;
OutBufPtr := 0;
Height := 0;
MatchPos := 0;
MatchLen := 0;
LastLen := 0;
FillChar(TextBufP^, SizeOf(TLZTextBuf), 0);
FillChar(LeftP^, SizeOf(TLeftMomTree), 0);
FillChar(MomP^, SizeOf(TLeftMomTree), 0);
FillChar(RightP^, SizeOf(TRightTree), 0);
FillChar(CodeBuf, SizeOf(CodeBuf), 0);
LZReadProc := ReadProc;
LZWriteProc := WriteProc;
Encode;
LZSS_Write
end
End; { LZSquash }
Procedure LZUnSquash;
Begin
if Initialized then
begin
InBufPtr := LZRWBufSize;
InBufSize := LZRWBufSize;
OutBufPtr := 0;
FillChar(TextBufP^, SizeOf(TLZTextBuf), 0);
LZReadProc := ReadProc;
LZWriteProc := WriteProc;
Decode;
LZSS_Write
end
End; { LZUnSquash }
{$IFDEF Windows}
Function HeapFunc(Size : word) : integer; far; assembler;
Asm
MOV AX,1
End; { HeapFunc }
{$ENDIF}
Begin
{$IFDEF Windows}
HeapError := @HeapFunc;
{$ENDIF}
Initialized := False
End. { LZSSUNIT }
{ ------------------------- DEMO ---------------------------------}
Program LZSSDemo;
{ Copyright (c) 1994 by Andrew Eigus Fidonet: 2:5100/33 }
{ Demonstrates the use of LZSSUnit (LZSSUNIT.PAS), Public Domain }
uses LZSSUnit;
var InFile, OutFile : file;
Function ToUpper(S : string) : string; assembler;
Asm
PUSH DS
CLD
LDS SI,S
LES DI,@Result
LODSB
STOSB
XOR AH,AH
XCHG AX,CX
JCXZ @@3
@@1:
LODSB
CMP AL,'a'
JB @@2
CMP AL,'z'
JA @@2
SUB AL,20h
@@2:
STOSB
LOOP @@1
@@3:
POP DS
End; { ToUpper }
Function ReadProc(var ReadBuf; var NumRead : word) : word; far;
Begin
BlockRead(InFile, ReadBuf, LZRWBufSize, NumRead);
Write(#13, FilePos(InFile), ' -> ')
End; { ReadProc }
Function WriteProc(var WriteBuf; Count : word; var NumWritten : word) : word;
far;Begin
BlockWrite(OutFile, WriteBuf, Count, NumWritten);
Write(FilePos(OutFile), #13)
End; { WriteProc }
Begin
if ParamCount < 2 then begin WriteLn('Usage: LZSSDEMO [unsquash]');
Halt(1)
end;
if not LZInit then
begin
WriteLn('Not enough memory');
Halt(8)
end;
Assign(InFile, ParamStr(1));
Reset(InFile, 1);
if IOResult = 0 then
begin
Assign(OutFile, ParamStr(2));
Rewrite(OutFile, 1);
if IOResult = 0 then
begin
if ToUpper(ParamStr(3)) = 'UNSQUASH' then
LZUnSquash(ReadProc, WriteProc)
else
LZSquash(ReadProc, WriteProc);
Close(OutFile)
end else WriteLn('Cannot create output file');
Close(InFile)
end else WriteLn('Cannot open input file');
LZDone;
WriteLn
End.