www.pudn.com > lzss.rar > LZSS16.PAS
{$G+}
Unit LZSS16;
{
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.
Written by Andrew Eigus (aka: Mr. Byte) of:
Fidonet: 2:5100/33,
Internet: aeigus@fgate.castle.riga.lv, aeigus@kristin.cclu.lv.
Modified again by Chris Rankin: apart from a few minor tweaks to the
code, the only real change is the grouping together of TextBuf, Left,
Right and Mom into a (large!) record which is allocated in a single
segment on the Heap. This enables ES to be loaded ONCE at the beginning
of LZEncode and LZDecode, *drastically* reducing the number of segment
loads during a typical LZ call. This should enhance performance,
especially under DPMI and Windows.
Public Domain version 1.10, last changed on 15.07.96.
Target platforms: DOS, DPMI, Windows.
}
interface
{#Z+}
{ This unit is ready for use with Dj. Murdoch's ScanHelp utility which
will make a Borland .TPH file for it ????? }
{#Z-}
type
TLZSSWord = word;
const Log2TLZSSWord = 1;
const
LZRWBufSize = 32000{8192}; { Read buffer size }
{#Z+}
N = 4096; { Bigger N -> Better compression on big files only. }
F = 18;
Threshold = 2;
Nul = N * SizeOf(TLZSSWord);
InBufPtr : TLZSSWord = LZRWBufSize;
InBufSize : TLZSSWord = LZRWBufSize;
OutBufPtr : TLZSSWord = 0;
{#Z-}
type
{#X TWriteProc}{#X LZSquash}{#X LZUnsquash}
TReadProc = function(var ReadBuf): TLZSSWord;
{ This is declaration for custom read function. It should read
#LZRWBufSize# bytes from ReadBuf, returning the number of bytes
actually read. }
{#X TReadProc}{#X LZSquash}{#X LZUnsquash}
TWriteProc = function(var WriteBuf;
Count: TLZSSWord): TLZSSWord;
{ This is declaration for custom write function. It should write
Count bytes into WriteBuf, returning the number of actual bytes
written. }
{#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 TLZSSWord;
PRightTree = ^TRightTree;
TRightTree = array[0..N + 256] of TLZSSWord;
PBinaryTree = ^TBinaryTree;
TBinaryTree = record
TextBuf: TLZTextBuf;
Left: TLeftMomTree;
Right: TRightTree;
Mom: TLeftMomTree
end;
const
LZSSMemRequired = SizeOf(TLZRWBuffer)*2 + SizeOf(TBinaryTree);
{#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}
procedure LZEncode;
procedure LZDecode;
{#Z+}
const BinaryTree: PBinaryTree = nil;
const InBufP: PLZRWBuffer = nil;
const OutBufP: PLZRWBuffer = nil;
const IsLZInitialized: boolean = false;
var
Height, MatchPos, MatchLen, LastLen: TLZSSWord;
CodeBuf : array[0..16] of Byte;
LZReadProc : TReadProc;
LZWriteProc : TWriteProc;
{#Z-}
implementation
type
PtrRec = record
Ofs, Seg: word
end;
Function LZSS_Read : TLZSSWord; { Returns # of bytes read }
Begin
LZSS_Read := LZReadProc(InBufP^);
End; { LZSS_Read }
Function LZSS_Write : TLZSSWord; { Returns # of bytes written }
Begin
LZSS_Write := LZWriteProc(OutBufP^, OutBufPtr);
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
push es
call LZSS_Read
pop es
pop si
pop di
pop dx
pop cx
mov inBufSize, ax
or ax, ax
jnz @NewBuf
stc { ; set carry to indicate EOF }
jmp @Exit
@NewBuf: xor bx, bx
@getc1: PUSH DI
PUSH ES
LES DI,[InBufP]
MOV AL,[ES:DI+BX]
POP ES
POP DI
inc bx
mov inBufPtr, bx
clc { ; clear the carry flag }
@Exit: pop bx
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
PUSH ES
LES DI,[OutBufP]
MOV [ES:DI+BX],AL
POP ES
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
push es
call LZSS_Write
pop es
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
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI, OFFSET TBinaryTree.Mom
mov cx, N+1
mov ax, Nul
rep stosw
{ }
{ Initialise last 256 elements to BinaryTree.Right to Nul ... }
{ }
add di, OFFSET TBinaryTree.Right - OFFSET TBinaryTree.Mom
mov ch, (256 shr 8)
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
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV SI,[ES:BX+DI+OFFSET TBinaryTree.Mom]
POP BX
{ mov si, [Offset Mom + di]}
cmp si, Nul { ; exit if its parent is a special node }
ja @Splay4
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV BX,[ES:BX+SI+OFFSET TBinaryTree.Mom]
{ mov bx, [Offset Mom + si]}
cmp bx, Nul { ; check if its grandparent is special }
jbe @Splay5 { ; if not then skip }
PUSH BX
MOV BX,PtrRec[BinaryTree].Ofs
CMP DI,[ES:BX+SI+OFFSET TBinaryTree.Left]
POP BX
{ cmp di, [Offset Left + si]} { ; is the current node is a left child ? }
jne @Splay2
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV DX,[ES:BX+DI+OFFSET TBinaryTree.Right]
{ mov dx, [Offset Right + di]} { ; perform a left zig operation }
MOV [ES:BX+SI+OFFSET TBinaryTree.Left],DX
{ mov [Offset Left + si], dx}
MOV [ES:BX+DI+OFFSET TBinaryTree.Right],SI
POP BX
{ mov [Offset Right + di], si}
jmp @Splay3
@Splay2:
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV DX,[ES:BX+DI+OFFSET TBinaryTree.Left]
{ mov dx, [Offset Left + di]} { ; perform a right zig }
MOV [ES:BX+SI+OFFSET TBinaryTree.Right],DX
{ mov [Offset Right + si], dx}
MOV [ES:BX+DI+OFFSET TBinaryTree.Left],SI
POP BX
{ mov [Offset Left + di], si}
@Splay3:
PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Right],DI
POP SI
{ mov [Offset Right + bx], di}
xchg bx, dx
PUSH AX
MOV AX,BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
ADD BX,AX
MOV [ES:BX+OFFSET TBinaryTree.Mom],SI
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:BX+SI+OFFSET TBinaryTree.Mom],DI
MOV [ES:BX+DI+OFFSET TBinaryTree.Mom],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
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
MOV CX,[ES:DI+BX+OFFSET TBinaryTree.Mom]
POP DI
{ mov cx, [Offset Mom + bx]}
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
CMP DI,[ES:BX+SI+OFFSET TBinaryTree.Left]
POP BX
{ cmp di, [Offset Left + si]}
jne @Splay7
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
CMP SI,[ES:DI+BX+OFFSET TBinaryTree.Left]
POP DI
{ cmp si, [Offset Left + bx]}
jne @Splay6
PUSH AX
MOV AX,DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
MOV DX,[ES:DI+OFFSET TBinaryTree.Right]
{ mov dx, [Offset Right + si] } { ; perform a left zig-zig operation }
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:DI+BX+OFFSET TBinaryTree.Left],DX
{ mov [Offset Left + bx], dx}
xchg bx, dx
MOV [ES:DI+BX+OFFSET TBinaryTree.Mom],DX
{ mov [Offset Mom + bx], dx}
ADD DI,AX
MOV BX,[ES:DI+OFFSET TBinaryTree.Right]
{ mov bx, [Offset Right + di]}
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
MOV [ES:DI+OFFSET TBinaryTree.Left],BX
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:DI+BX+OFFSET TBinaryTree.Mom],SI
{ mov [Offset Left +si], bx
mov [Offset Mom + bx], si}
mov bx, dx
ADD DI,SI
MOV [ES:DI+OFFSET TBinaryTree.Right],BX
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,AX
MOV [ES:DI+OFFSET TBinaryTree.Right],SI
{ mov [Offset Right + si], bx
mov [Offset Right + di], si}
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:DI+BX+OFFSET TBinaryTree.Mom],SI
ADD DI,SI
MOV [ES:DI+OFFSET TBinaryTree.Mom], AX
MOV DI,AX
POP AX
{ mov [Offset Mom + bx], si
mov [Offset Mom + si], di}
jmp @Splay9
@Splay6:
PUSH AX
MOV AX,SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV DX,[ES:SI+OFFSET TBinaryTree.Left]
{ mov dx, [Offset Left + di]} { ; perform a left zig-zag operation }
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Right],DX
{ mov [Offset Right + bx], dx}
xchg bx, dx
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],DX
{ mov [Offset Mom + bx], dx}
ADD SI,DI
MOV BX,[ES:SI+OFFSET TBinaryTree.Right]
{ mov bx, [Offset Right + di]}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,AX
MOV [ES:SI+OFFSET TBinaryTree.Left],BX
{ mov [Offset Left + si], bx}
MOV SI, PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],AX
{ mov [Offset Mom + bx], si}
mov bx, dx
ADD SI,DI
MOV [ES:SI+OFFSET TBinaryTree.Left],BX
{ mov [Offset Left + di], bx}
MOV SI, PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV [ES:SI+OFFSET TBinaryTree.Right],AX
{ mov [Offset Right + di], si}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,AX
MOV [ES:SI+OFFSET TBinaryTree.Mom],DI
{ mov [Offset Mom + si], di}
MOV SI, PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],DI
MOV SI,AX
POP AX
{ mov [Offset Mom + bx], di}
jmp @Splay9
@Splay7:
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
CMP SI,[ES:DI+BX+OFFSET TBinaryTree.Right]
POP DI
{ cmp si, [Offset Right + bx]}
jne @Splay8
PUSH AX
MOV AX,SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,AX
MOV DX,[ES:SI+OFFSET TBinaryTree.Left]
{ mov dx, [Offset Left + si]} { ; perform a right zig-zig }
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Right],DX
{ mov [Offset Right + bx], dx}
xchg bx, dx
MOV SI, PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],DX
{ mov [Offset Mom + bx], dx}
ADD SI,DI
MOV BX,[ES:SI+OFFSET TBinaryTree.Left]
{ mov bx, [Offset Left + di]}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,AX
MOV [ES:SI+OFFSET TBinaryTree.Right],BX
{ mov [Offset Right + si], bx}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],AX
{ mov [Offset Mom + bx], si}
mov bx, dx
ADD SI,AX
MOV [ES:SI+OFFSET TBinaryTree.Left],BX
{ mov [Offset Left + si], bx}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV [ES:SI+OFFSET TBinaryTree.Left],AX
{ mov [Offset Left + di], si}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],AX
{ mov [Offset Mom + bx], si}
ADD SI,AX
MOV [ES:SI+OFFSET TBinaryTree.Mom],DI
{ mov [Offset Mom + si], di}
MOV SI,AX
POP AX
jmp @Splay9
@Splay8:
PUSH AX
MOV AX,SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV DX,[ES:SI+OFFSET TBinaryTree.Right]
{ mov dx, [Offset Right + di]} { ; perform a right zig-zag }
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Left],DX
{ mov [Offset Left + bx], dx}
xchg bx, dx
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],DX
{ mov [Offset Mom + bx], dx}
ADD SI,DI
MOV BX,[ES:SI+OFFSET TBinaryTree.Left]
{ mov bx, [Offset Left + di]}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,AX
MOV [ES:SI+OFFSET TBinaryTree.Right],BX
{ mov [Offset Right + si], bx}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],AX
{ mov [Offset Mom + bx], si}
mov bx, dx
ADD SI,DI
MOV [ES:SI+OFFSET TBinaryTree.Right],BX
{ mov [Offset Right + di], bx}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV [ES:SI+OFFSET TBinaryTree.Left],AX
{ mov [Offset Left + di], si}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,AX
MOV [ES:SI+OFFSET TBinaryTree.Mom],DI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],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
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
CMP BX,[ES:DI+OFFSET TBinaryTree.Left]
POP DI
{ cmp bx, [Offset Left + si]}
jne @Splay10
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:BX+SI+OFFSET TBinaryTree.Left],DI
POP BX
{ mov [Offset Left + si], di}
jmp @Splay11
@Splay10:
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:BX+SI+OFFSET TBinaryTree.Right],DI
POP BX
{ mov [Offset Right + si], di}
@Splay11:
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:BX+DI+OFFSET TBinaryTree.Mom],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
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV AL,BYTE PTR [ES:SI]
{ mov al, byte ptr [Offset TextBuf + di]}
shl di, Log2TLZSSWord
add ax, N + 1
shl ax, Log2TLZSSWord
mov si, ax
mov ax, NUL
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:BX+DI+OFFSET TBinaryTree.Right],AX
{ mov word ptr [Offset Right + di], ax}
MOV [ES:BX+DI+OFFSET TBinaryTree.Left],AX
POP BX
{ mov word ptr [Offset Left + di], ax}
@Ins1: inc height
test dx, dx
mov dx, Nul
js @Ins3
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
MOV AX,[ES:DI+OFFSET TBinaryTree.Right]
POP DI
{ mov ax, word ptr [Offset Right + si]}
cmp ax, dx
jne @Ins5
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:BX+SI+OFFSET TBinaryTree.Right],DI
{ mov word ptr [Offset Right + si], di}
MOV [ES:BX+DI+OFFSET TBinaryTree.Mom],SI
POP BX
{ mov word ptr [Offset Mom + di], si}
jmp @Ins11
@Ins3:
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV AX,[ES:BX+SI+OFFSET TBinaryTree.Left]
POP BX
{ mov ax, word ptr [Offset Left + si]}
cmp ax, dx
jne @Ins5
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:BX+SI+OFFSET TBinaryTree.Left],DI
{ mov word ptr [Offset Left + si], di}
MOV [ES:BX+DI+OFFSET TBinaryTree.Mom],SI
POP BX
{ mov word ptr [Offset Mom + di], si}
jmp @Ins11
@Ins5: mov si, ax
mov bx, 1
shr si, Log2TLZSSWord
shr di, Log2TLZSSWord
xor ch, ch
xor dh, dh
@Ins6:
PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV DL,[ES:SI+BX]
POP SI
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
MOV CL,[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: mov ax, si
shl si, Log2TLZSSWord
shl di, Log2TLZSSWord
cmp bx, matchLen
jbe @Ins1
mov matchPos, ax
mov matchLen, bx
cmp bx, F
jb @Ins1
@Ins8:
PUSH CX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV AX,[ES:BX+SI+OFFSET TBinaryTree.Mom]
{ mov ax, word ptr [Offset Mom + si]}
MOV [ES:BX+DI+OFFSET TBinaryTree.Mom],AX
{ mov word ptr [Offset Mom + di], ax}
MOV CX,[ES:BX+SI+OFFSET TBinaryTree.Left]
{ mov bx, word ptr [Offset Left + si]}
MOV [ES:BX+DI+OFFSET TBinaryTree.Left],CX
{ mov word ptr [Offset Left + di], bx}
ADD BX,CX
MOV [ES:BX+OFFSET TBinaryTree.Mom],DI
{ mov word ptr [Offset Mom + bx], di}
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV CX,[ES:BX+SI+OFFSET TBinaryTree.Right]
{ mov bx, word ptr [Offset Right + si]}
MOV [ES:BX+DI+OFFSET TBinaryTree.Right],CX
{ mov word ptr [Offset Right + di], bx}
ADD BX,CX
MOV [ES:BX+OFFSET TBinaryTree.Mom],DI
{ mov word ptr [Offset Mom + bx], di}
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV BX,[ES:BX+SI+OFFSET TBinaryTree.Mom]
{ mov bx, word ptr [Offset Mom + si]}
POP CX
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
CMP SI,[ES:DI+BX+OFFSET TBinaryTree.Right]
POP DI
{ cmp si, word ptr [Offset Right + bx]}
jne @Ins9
PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Right],DI
POP SI
{ mov word ptr [Offset Right + bx], di}
jmp @Ins10
@Ins9:
PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Left],DI
POP SI
{ mov word ptr [Offset Left + bx], di}
@Ins10:
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
MOV WORD PTR [ES:DI+OFFSET TBinaryTree.Mom],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, Log2TLZSSWord
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, Log2TLZSSWord
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
CMP WORD PTR [ES:DI+OFFSET TBinaryTree.Mom], Nul
POP DI
{ cmp word ptr [Offset Mom + si], NUL} { ; if it has no parent then exit }
je @del7
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
CMP WORD PTR [ES:DI+OFFSET TBinaryTree.Right],Nul
POP DI
{ cmp word ptr [Offset Right + si], NUL} { ; does it have right child ? }
jne @HasRight
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV DI,[ES:BX+SI+OFFSET TBinaryTree.Left]
POP BX
{ mov di, word ptr [Offset Left + si]}
jmp @del3
@HasRight: PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV DI,[ES:BX+SI+OFFSET TBinaryTree.Left]
POP BX
{ mov di, word ptr [Offset Left + si] } { ; does it have left child ? }
cmp di, Nul
jne @HasLeft
PUSH BX
MOV BX,PtrRec[OFFSET BinaryTree].Ofs
MOV DI,[ES:BX+SI+OFFSET TBinaryTree.Right]
POP BX
{ mov di, word ptr [Offset Right + si]}
jmp @del3
@HasLeft: PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV AX,[ES:SI+OFFSET TBinaryTree.Right]
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
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV AX,[ES:SI+OFFSET TBinaryTree.Right]
POP SI
{ mov ax, word ptr [Offset Right + di] } { ; the right subtree }
cmp ax, Nul
jne @del1
PUSH CX
MOV CX,SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV BX,[ES:SI+OFFSET TBinaryTree.Mom]
{ mov bx, word ptr [Offset Mom + di] } { ; move this node as the root of }
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV AX,[ES:SI+OFFSET TBinaryTree.Left]
{ mov ax, word ptr [Offset Left + di]} { ; the subtree }
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Right],AX
{ mov word ptr [Offset Right + bx], ax}
xchg ax, bx
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],AX
{ mov word ptr [Offset Mom + bx], ax}
ADD SI,CX
MOV BX,[ES:SI+OFFSET TBinaryTree.Left]
{ mov bx, word ptr [Offset Left + si]}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV [ES:SI+OFFSET TBinaryTree.Left],BX
{ mov word ptr [Offset Left + di], bx}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],DI
{ mov word ptr [Offset Mom + bx], di}
MOV SI,CX
POP CX
@del2:
PUSH CX
MOV CX,SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,CX
MOV BX,[ES:SI+OFFSET TBinaryTree.Right]
{ mov bx, word ptr [Offset Right + si]}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV [ES:SI+OFFSET TBinaryTree.Right],BX
{ mov word ptr [Offset Right + di], bx}
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Mom],DI
MOV SI,CX
POP CX
{ mov word ptr [Offset Mom + bx], di}
@del3:
PUSH CX
MOV CX,DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
MOV BX,[ES:DI+OFFSET TBinaryTree.Mom]
{ mov bx, word ptr [Offset Mom + si]}
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,CX
MOV [ES:DI+OFFSET TBinaryTree.Mom],BX
{ mov word ptr [Offset Mom + di], bx}
MOV DI,CX
POP CX
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
CMP SI,[ES:DI+BX+OFFSET TBinaryTree.Right]
POP DI
{ cmp si, word ptr [Offset Right + bx]}
jne @del4
PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Right],DI
POP SI
{ mov word ptr [Offset Right + bx], di}
jmp @del5
@del4:
PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV [ES:SI+BX+OFFSET TBinaryTree.Left],DI
POP SI
{ mov word ptr [Offset Left + bx], di}
@del5:
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
MOV WORD PTR [ES:DI+OFFSET TBinaryTree.Mom],Nul
POP DI
{ mov word ptr [Offset Mom + si], NUL}
@del7: pop bx
pop di
shr si, Log2TLZSSWord
@end:
End; { DeleteNode }
Procedure LZEncode; assembler;
Asm
{ }
{ Load ES with segment of Binary Tree structure ... }
{ }
MOV ES, PtrRec[OFFSET BinaryTree].&Seg
{ }
{ Now encode ... }
{ }
call initTree
xor bx, bx
mov [Offset CodeBuf], bl
mov dx, 1
mov ch, dl
xor si, si
mov di, N - F
@Encode2: call getc
jnc @ReadOK
or bx, bx
je @Encode19
jmp @Encode4
@ReadOK: PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV [ES:SI+BX],AL
POP SI
{ mov byte ptr [Offset TextBuf +di + bx], al}
inc bx
cmp bx, F
jb @Encode2
@Encode4: mov cl, bl
xor bx, bx
push di
dec di
@Encode5: call InsertNode
inc bx
dec di
cmp bx, F
jb @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
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV AL,[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 ax, MatchPos
mov byte ptr [Offset Codebuf + bx], al
inc bx
push cx
mov cl, 4
shl ah, cl
pop cx
mov al, byte ptr MatchLen
sub al, THRESHOLD + 1
add ah, al
mov byte ptr [Offset Codebuf + bx], ah
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 @EncodeY
push ax
call deleteNode
pop ax
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
STOSB
POP DI
{ mov byte ptr [Offset TextBuf + si], al}
cmp si, F - 1
jae @Encode13
PUSH DI
MOV DI,PtrRec[OFFSET BinaryTree].Ofs
ADD DI,SI
MOV [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
jmp @Encode16
(* @Encode14: sub printCount, bx
jnc @EncodeY
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 *)
@EncodeX: inc bx
call deleteNode
inc si
and si, N - 1
inc di
and di, N - 1
dec cl
jz @EncodeY
call insertNode
@EncodeY: cmp bx, LastLen
jb @EncodeX
@Encode16: test cl, cl
jnz @Encode6
@Encode17: test dx, dx
jz @Encode19
xor bx, bx
@Encode18: mov al, byte ptr [Offset Codebuf + bx]
call putc
inc bx
cmp bx, dx
jb @Encode18
@Encode19:
call LZSS_Write
End; { Encode }
Procedure LZDecode; assembler;
Asm
{ }
{ Load ES with segment of Binary Tree structure ... }
{ }
MOV ES, PtrRec[OFFSET BinaryTree].&Seg
{ }
{ Now decode ... }
{ }
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: call getc
jc @Decode9
test dl, 1
jz @Decode4
PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
ADD SI,DI
MOV [ES:SI],AL
POP SI
{ mov byte ptr [Offset TextBuf + di], al}
inc di
and di, N - 1
call putc
jmp @Decode2
@Decode4: mov bl, al
call getc
jc @Decode9
mov bh, al
{$IFOPT G+}
shr bh, 4
{$ELSE}
mov cl, 4
shr bh, cl
{$ENDIF}
mov cl, al
and cl, 0fh
add cl, THRESHOLD
inc cl
@Decode5: and bx, N - 1
PUSH SI
MOV SI,PtrRec[OFFSET BinaryTree].Ofs
MOV AL,[ES:SI+BX]
ADD SI,DI
MOV [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:
call LZSS_Write
End; { Decode }
Function LZInit : boolean;
label
LZAbort;
Begin
{
*Non-interruptable* test for whether LZ unit is busy ...
}
asm
MOV AL, True { if IsLZInitialized then goto LZAbort; }
XCHG IsLZInitialized, AL { IsLZInitialized := True; }
TEST AL, AL
JNZ LZAbort
end;
{
Unit WASN'T busy, but it is now ...
}
New(InBufP);
New(OutBufP);
New(BinaryTree);
if (InBufP = nil) or (OutBufP = nil) or (BinaryTree = nil) then
LZDone;
LZAbort:
LZInit := IsLZInitialized
End; { LZInit }
Procedure LZDone;
Begin
if InBufP <> nil then
Dispose(InBufP);
if OutBufP <> nil then
Dispose(OutBufP);
if BinaryTree <> nil then
Dispose(BinaryTree);
IsLZInitialized := False
End; { LZDone }
Procedure LZSquash;
Begin
if IsLZInitialized then
begin
InBufPtr := LZRWBufSize;
InBufSize := LZRWBufSize;
OutBufPtr := 0;
Height := 0;
MatchPos := 0;
MatchLen := 0;
LastLen := 0;
FillChar(BinaryTree^, SizeOf(TBinaryTree), 0);
FillChar(CodeBuf, SizeOf(CodeBuf), 0);
LZReadProc := ReadProc;
LZWriteProc := WriteProc;
LZEncode
end
End; { LZSquash }
Procedure LZUnSquash;
Begin
if IsLZInitialized then
begin
InBufPtr := LZRWBufSize;
InBufSize := LZRWBufSize;
OutBufPtr := 0;
FillChar(BinaryTree^.TextBuf, SizeOf(TLZTextBuf), 0);
LZReadProc := ReadProc;
LZWriteProc := WriteProc;
LZDecode;
end
End; { LZUnSquash }
{$IFDEF Windows}
Function HeapFunc(Size : word) : integer; far; assembler;
Asm
MOV AX,1
End; { HeapFunc }
{$ENDIF}
{$IFDEF Windows}
Begin
HeapError := @HeapFunc;
{$ENDIF}
End. { LZSSUNIT }