lzss32.pas

delhpi下lzss加密算法源码及例子

{$A+,B-,C-,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N-,O+,P-,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{
  LZ77 compression for 32-bit Delphi 2: Ported by C.J.Rankin from
  the 16-bit unit LZSSUnit.

  Rumour has it that the Pentium Pro cannot handle `partial register
  loads' efficiently; apparently, assigning a value to AL,AH,AX (e.g.)
  and then reading EAX, or assigning AL,AH and reading AX causes the
  pipelines to stall. Call me optimistic/pedantic, but I have tried to
  avoid this where possible.


  Original unit credits:
   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: [e-mail], [e-mail].
}
unit LZSS32;

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 Log2TLZSSWord = 2;
{#Z+}
type TLZSSWord = Cardinal;
{#Z-}

const
  LZRWBufSize = 32000{8192};  { Read Buffer Size }

{#Z+}
const
  N         = 4096;
  F         =   18;
  Threshold =    2;
  Nul       = N*SizeOf(TLZSSWord);

var
  InBufPtr:  TLZSSWord = LZRWBufSize;
  InBufSize: TLZSSWord = LZRWBufSize;
  OutBufPtr: TLZSSWord = 0;

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+}
type
  PLZRWBuffer = ^TLZRWBuffer;
  TLZRWBuffer = array[0..LZRWBufSize - 1] of Byte; { file buffers }

  TLZTextBuf = array[0..N + F - 2] of Byte;
  TLeftMomTree = array[0..N] of TLZSSWord;
  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}

{#Z+}
var IsLZInitialized : boolean = False;

var
  Height, MatchPos, MatchLen, LastLen : TLZSSWord;
  CodeBuf : array[0..16] of Byte;
  LZReadProc:  TReadProc;
  LZWriteProc: TWriteProc;

var BinaryTree: PBinaryTree = nil;
var InBufP:     PLZRWBuffer = nil;
var OutBufP:    PLZRWBuffer = nil;
{#Z-}

procedure LZEncode;
procedure LZDecode;

implementation

function LZSS_Read: TLZSSWord;    { Returns # of bytes read }
begin
  Result := LZReadProc(InBufP^)
end; { LZSS_Read }

function LZSS_Write: TLZSSWord;  { Returns # of bytes written }
begin
  Result := LZWriteProc(OutBufP^, OutBufPtr)
end; { LZSS_Write }

procedure GetC; assembler;
{
  GetC : return a character from the buffer
          RETURN : AL = input char
                   Carry set when EOF
}
asm
{                                          }
{ Check for characters in Input Buffer ... }
{                                          }
  MOV EAX, InBufPtr
  CMP EAX, InBufSize
  JB @GetC2
{                                           }
{ All chars read. Need to refill buffer ... }
{                                           }
  PUSHAD
  CALL LZSS_Read
  MOV InBufSize, EAX
  TEST EAX, EAX
  POPAD
  JNZ @GetC1
{                                        }
{ No bytes read, so EOF: set carry flag. }
{                                        }
  STC
  JMP @Exit
@GetC1:
  XOR EAX, EAX
@GetC2:
  PUSH EBX
  MOV EBX, [OFFSET InBufP]
  MOV EBX, [EBX+EAX]    // Only interested in BL
  INC EAX
  MOV [OFFSET InBufPtr], EAX
  MOV EAX, EBX  // Only interested in AL
  POP EBX
  CLC
@Exit:
end;

procedure PutC; assembler;
{
  PutC : put a character into the output buffer
             Entry : AL = output char
}
asm
  PUSH EBX
{                               }
{ Store AL in Output buffer ... }
{                               }
  MOV EBX, [OFFSET OutBufPtr]
  PUSH EDI
  MOV EDI, [OFFSET OutBufP]
  MOV [EBX+EDI], AL
  POP EDI
{                                  }
{ Check whether buffer is full ... }
{                                  }
  INC EBX
  CMP EBX, LZRWBufSize
  MOV [OFFSET OutBufPtr], EBX
  POP EBX
  JB @Exit
{                                                                          }
{ Buffer *IS* full, so flush it (having just set OutBufPtr to LZWRBufSize) }
{                                                                          }
  PUSHAD
  CALL LZSS_Write  // Returns bytes written in EAX ... (not!)
  POPAD
  XOR EAX, EAX
  MOV [OFFSET OutBufPtr], EAX
@Exit:
end;

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 of tree K is the node N + K + 1 and it has only a
             right child
}
asm
  MOV EDI, [OFFSET BinaryTree]
  ADD EDI, OFFSET TBinaryTree.Mom
  MOV ECX, N+1
  MOV EAX, Nul
  REP STOSD
{                                                         }
{ Initialise last 256 elements of BinaryTree.Right to Nul }
{                                                         }
  ADD EDI, OFFSET TBinaryTree.Right - OFFSET TBinaryTree.Mom
  MOV CH, (256 SHR 8)    (* i.e. MOV ECX, 256 *)
  REP STOSD
end;

{
{ These procedures used by Splay:   }
{    EBP      = Addr of Mom         }
{    EAX, ECX = Addr of Left, Right }
{                                   }
procedure ZigZig; assembler;
asm
  MOV EDX, [EAX+ESI]
  MOV [ECX+EBX], EDX
  MOV [EBP+EDX], EBX
  MOV EDX, [EAX+EDI]
  MOV [ECX+ESI], EDX
  MOV [EBP+EDX], ESI
  MOV [EAX+ESI], EBX
  MOV [EAX+EDI], ESI
  MOV [EBP+EBX], ESI
  MOV [EBP+ESI], EDI
end;

procedure ZigZag; assembler;
asm
  MOV EDX, [ECX+EDI]
  MOV [EAX+EBX], EDX
  MOV [EBP+EDX], EBX
  MOV EDX, [EAX+EDI]
  MOV [ECX+ESI], EDX
  MOV [EBP+EDX], ESI
  MOV [ECX+EDI], EBX
  MOV [EAX+EDI], ESI
  MOV [EBP+ESI], EDI
  MOV [EBP+EBX], EDI
end;

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 : EDI = the node to be rotated

  All registers except EDI are expendable
}
asm
{                                                               }
{ Load location of Binary Tree Structure's Mom-array into EBP   }
{                                          Right-array into ECX }
{                                          Left-array into EAX  }
  MOV EAX, [OFFSET BinaryTree]
  LEA EBP, TBinaryTree[EAX].Mom
  LEA ECX, TBinaryTree[EAX].Right
  ADD EAX, OFFSET TBinaryTree.Left
{                           }
{ Begin Splay operation ... }
{                           }
@Splay1:
  MOV ESI, [EBP+EDI]
  CMP ESI, Nul
  JA @Exit      // Exit if parent is special

  MOV EBX, [EBP+ESI]
  CMP EBX, Nul
  JBE @Splay5  // If nodes's grandparent is NOT special, skip it

  CMP EDI, [EAX+ESI] // Check whether current node is left-child
  JNE @Splay2

  MOV EDX, [ECX+EDI]  // Perform Left-Zig
  MOV [EAX+ESI], EDX
  MOV [ECX+EDI], ESI
  JMP @Splay3

@Splay2:
  MOV EDX, [EAX+EDI]  // Perform Right-Zig
  MOV [ECX+ESI], EDX
  MOV [EAX+EDI], ESI

@Splay3:
  MOV [ECX+EBX], EDI
  MOV [EBP+EDX], ESI
  MOV [EBP+ESI], EDI
  MOV [EBP+EDI], EBX
  JMP @Exit

@Splay5:
  PUSH DWORD PTR [EBP+EBX]
  CMP EDI, [EAX+ESI]
  JNE @Splay7
  CMP ESI, [EAX+EBX]
  XCHG EAX, ECX       // Swap Left and Right over (temporarily!)
  JNE @Splay6
{                             }
{ Perform Left-operations ... }
{                             }
  CALL ZigZig
  XCHG EAX, ECX       // Swap Left and Right back
  JMP @Splay9

@Splay6:
  CALL ZigZag
  XCHG EAX, ECX      // Swap Left and Right back
  JMP @Splay9
{                              }
{ Perform Right-operations ... }
{                              }
@Splay7:
  CMP ESI, [ECX+EBX]
  JNE @Splay8
  CALL ZigZig
  JMP @Splay9

@Splay8:
  CALL ZigZag
{                    }
{ Done operations... }
{                    }
@Splay9:
  POP ESI
  CMP ESI, Nul
  JA @Splay10
  CMP EBX, [EAX+ESI]
  JNE @Splay10
  MOV [EAX+ESI], EDI
  JMP @Splay11

@Splay10:
  MOV [ECX+ESI], EDI

@Splay11:
  MOV [EBP+EDI], ESI
  JMP @Splay1

@Exit:
end;

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 : EDI = position in the buffer
}
asm
  PUSHAD
  MOV EBP, [OFFSET BinaryTree]  // EBP now holds address of TextBuf
{                }
{ Initialise ... }
{                }
  XOR EDX, EDX
  INC EDX

  XOR EAX, EAX
  MOV [OFFSET MatchLen], EAX
  MOV [OFFSET Height], EAX

  MOVZX EAX, BYTE PTR [EBP+EDI]
  SHL EDI, Log2TLZSSWord
  LEA ESI, [EAX*(TYPE TLZSSWord)+(N+1)*(TYPE TLZSSWord)]
  MOV EAX, Nul
  MOV [EBP+EDI+OFFSET TBinaryTree.Right], EAX
  MOV [EBP+EDI+OFFSET TBinaryTree.Left], EAX
{                                                 }
{ Initialisation complete. Now to insert node ... }
{                                                 }
@Ins1:
  INC Height
  TEST EDX, EDX
  MOV EDX, Nul
  JS @Ins3
{                                         }
{ Does this character have a Right-tree ? }
{                                         }
  MOV EAX, [EBP+ESI+OFFSET TBinaryTree.Right]
  CMP EAX, EDX   // EDX = Nul
  JNE @Ins5
  MOV [EBP+ESI+OFFSET TBinaryTree.Right], EDI   // New Tree
  MOV [EBP+EDI+OFFSET TBinaryTree.Mom], ESI
  JMP @Ins11
{                                        }
{ Does this character have a Left-tree ? }
{                                        }
@Ins3:
  MOV EAX, [EBP+ESI+OFFSET TBinaryTree.Left]
  CMP EAX, EDX  // EDX = Nul
  JNE @Ins5
  MOV [EBP+ESI+OFFSET TBinaryTree.Left], EDI   // New Tree
  MOV [EBP+EDI+OFFSET TBinaryTree.Mom], ESI
  JMP @Ins11
{                                                               }
{ Prepare to scan TextBuf: starting points ESI, EDI; length EBX }
{                                                               }
@Ins5:
  MOV ESI, EAX
  XOR EBX, EBX
  INC EBX