{---------------------------------------------------------------------------
(c) Copyright	 Aleksandrov O.E., 1999

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

(c) Copyright Александров О.Е., 1999

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
Unit HuffSupp;

INTERFACE
   USES HufTypes;

{ Вычисляет размер упакованого дерева (в байтах)
для TreeSizeInNodes узлов в дереве }
function CalculateSizeOfPackedTreeInBytes(TreeSizeInNodes:tBaseNodeIndex):word;
function SizeOfPackedTreeInBytes(const TreeIndexes:tTreeIndexes):word;
function SizeOfTreeInNodes(const TreeIndexes:tTreeIndexes):tBaseNodeIndex;
function CompressedSize(const NodesData:tNodesData; const Codes:tCodes):tBufferIndex;


{ Инициализирует массив индексов }
procedure InitIndexes(var Indexes:tIndexes);
{ Инициализирует массив БАЗОВЫХ индексов }
procedure InitBaseIndexes(var Indexes:tBaseIndexes);


type

(*  {Сортировка массива индексов узлов по возрастанию }
  tNodeSort=object(tQSort)
    public
      constructor Init(var Indexes:tIndexes; Size:tIndex; const NodesData:tNodesData);
      procedure   DoSort;
      constructor InitAndSort(var Indexes:tIndexes; Size:tIndex; const NodesData:tNodesData);
    private
      PNodesData:tPNodesData;
      PIndexes:tPIndexes;
      lSize:tIndex;
      function  Compare(i,j:tElementNumber):boolean; virtual;
      procedure Exchange(i,j:tElementNumber); virtual;
  end;
*)
  { Упакованное дерево }
  tPackedTreeSize=0..((9*2*256+7) div 8);
  tPackedTree=object
    public
      { Упаковывает дерево }
      procedure PackA(const Tree:tTreeData; TreeSize:tBaseNodeIndex);
      procedure PackS(const Tree:tTreeData; TreeSize:tBaseNodeIndex);
      { Распаковывает дерево }
      procedure UnPackA(var Tree:tTreeData);
      procedure UnPackS(var Tree:tTreeData);
      { размер дерева в узлах }
      function SizeInNodes:tByte;
      { размер упакованного дерева }
      function  SizeInBytes:word;
    private
      lSizeInNodes:tByte;
      Data:array[tPackedTreeSize] of byte;
  end;
  tPPackedTree=^tPackedTree;


procedure ClearNodes(var Nodes:tNodes);
procedure ClearNodesEx(var Nodes:tNodes; Count:word);
procedure ClearNodesData(var NodesData:tNodesData);
procedure ClearTreeIndexes(var TreeIndexes:tTreeIndexes);

IMPLEMENTATION
  Uses xStrings {$IfDef Delphi}, Windows{$EndIf};

function SizeOfTreeInNodes;
begin
  if TreeIndexes.Root>=cBaseNodeCount then begin
    SizeOfTreeInNodes:=Succ(TreeIndexes.Root-cBaseNodeCount);
  end else begin
    SizeOfTreeInNodes:=0;
  end;
end;

function CompressedSize;
  var
    i:tBaseNodeIndex; s:tBufferIndex; t:longint;
  const
    cSizeOfTByteInBits=8*SizeOf(tByte);
    cSizeOfCode=SizeOf(tCode);
    cSizeOfNodeData=SizeOf(tNodeData);
    cCount=High(i);
begin
  s:=0; t:=0;
  for i:=Low(i) to High(i) do begin
    t:=Codes[i].Length*NodesData[i].Counter+(t mod cSizeOfTByteInBits);
    Inc(s,(t div cSizeOfTByteInBits));
  end;
  if (t mod cSizeOfTByteInBits)>0 then Inc(s);
  CompressedSize:=s;
(*  asm
    push ds
    mov cx,cCount
    xor bx,bx
    mov sr,bx
    les di,Codes
    lds si,NodesData
    @loop:
       mov al,tCode(es:[di]).Length
       xor ah,ah; cwd
       mul tNodeData([si]).Counter
       add di,cSizeOfCode
       add si,cSizeOfNodeData
       add ax,sr; adc dx,0
       mov sr,ax; and sr,7
       shr ax,3; and dl,7; shl dl,3
       or ah,dl
       add bx,ax
    loop @loop
    cmp sr,0; je @Skip
      inc bx
    @Skip:
    mov s,bx
    pop ds
  end;
  CompressedSize:=s;*)
end;

procedure ClearNodes(var Nodes:tNodes);
begin
  ClearNodesEx(Nodes, Succ(High(tNodeIndex)));
end;

procedure ClearNodesEx;
  var sz:word;
begin
  { Очистка основных данных дерева }
  (* for i:=1 to Count do Nodes[i]:=cNode0; { эквивалентная инструкция } *)
  sz:=SizeOf(Nodes[0])*Count;
  if sz>SizeOf(Nodes) then sz:=SizeOf(Nodes);
  FillMemByPattern(Nodes,sz, cNode0, SizeOf(cNode0));
end;

procedure ClearNodesData(var NodesData:tNodesData);
  const cNodeData0:tNodeData=(Counter:0; NextNode:-1);
begin
  { Очистка доп. данных дерева }
  (* for i:=1 to High(i) do NodesData[i]:=cNodeData0; { эквивалентная инструкция } *)
  FillMemByPattern(NodesData,SizeOf(NodesData), cNodeData0, SizeOf(cNodeData0));
end;

procedure ClearTreeIndexes(var TreeIndexes:tTreeIndexes);
begin
  { Инициализация вспомогательных индексов }
  TreeIndexes.Root:=0;
  TreeIndexes.MaxCode:=0;
  TreeIndexes.MinCode:=0;
end;

(*type
  tNodeSortData=record
    PNodesData:tPNodesData;
    PIndexes:tPIndexes;
  end;

function NodeSortCompare(i,j:tElementNumber; var UserData):boolean; far;
  var PIs:tPIndexes; PNDs:tPNodesData;
begin
  PIs:=tNodeSortData(UserData).PIndexes;
  PNDs:=tNodeSortData(UserData).PNodesData;
  NodeSortCompare:=PNDs^[PIs^[i]].Counter<=PNDs^[PIs^[j]].Counter;
end;

procedure NodeSortExchange(i,j:tElementNumber; var UserData); far;
  var tmp:tNodeIndex; PIi,PIj:^tIndex;
begin
  PIi:=@tNodeSortData(UserData).PIndexes^[i];
  PIj:=@tNodeSortData(UserData).PIndexes^[j];
  tmp:=PIi^; PIi^:=PIj^; PIj^:=tmp;
end;

procedure NodeSort(StartIndex,EndIndex:tIndex;
		   var Indexes:tIndexes;
		   const NodesData:tNodesData);
  var
    NodeSortData:tNodeSortData;
begin
  NodeSortData.PIndexes:=@Indexes;
  NodeSortData.PNodesData:=@NodesData;
  QSort.Sort(StartIndex, EndIndex,
	     NodeSortData,
	     NodeSortCompare,
	     NodeSortExchange
  );
end;

procedure BaseNodeSort(var Indexes:tIndexes; const NodesData:tNodesData);
begin
  NodeSort(0,Pred(cBaseNodeCount), Indexes,  NodesData);
end;

function tNodeSort.Compare;
  var PIs:tPIndexes; PNDs:tPNodesData;
begin
  PIs:=PIndexes;
  PNDs:=PNodesData;
  Compare:=PNDs^[PIs^[i]].Counter<=PNDs^[PIs^[j]].Counter;
end;

procedure tNodeSort.Exchange;
  var tmp:tNodeIndex; PIs:tPIndexes; PIi,PIj:^tIndex;
begin
  PIs:=PIndexes; PIi:=@PIs^[i]; PIj:=@PIs^[j];
  tmp:=PIi^; PIi^:=PIj^; PIj^:=tmp;
end;

constructor tNodeSort.Init;
begin
  Inherited Init;
  PNodesData:=@NodesData;
  PIndexes:=@Indexes;
  lSize:=Size;
end;

constructor tNodeSort.InitAndSort;
begin
  Init(Indexes, Size, NodesData);
  DoSort;
end;

procedure tNodeSort.DoSort;
begin
  Sort(Low(tBaseNodeIndex), Pred(lSize));
end;
*)

{ Размер дерева }
function tPackedTree.SizeInNodes;
begin
  SizeInNodes:=lSizeInNodes;
end;

function tPackedTree.SizeInBytes;
begin
  SizeInBytes:=CalculateSizeOfPackedTreeInBytes(SizeInNodes);
end;

type
  tTreePackBuffer=record
    case byte of
      0:(Word:word);
      1:(LoByte,HiByte:byte);
  end;

{ Упаковывает дерево }
procedure tPackedTree.PackS(const Tree:tTreeData; TreeSize:tBaseNodeIndex);
  var
    Buffer:tTreePackBuffer;
    j:tPackedTreeSize;
    l:0..16;
    PSelf:^tPackedTree;

  procedure PackRef(R:tNodeReference);
  begin
    Buffer.Word:=Buffer.Word or (R shl l);
    PSelf^.Data[j]:=Buffer.LoByte;
    Inc(l); Inc(j);
    if l=8 then begin
      PSelf^.Data[j]:=Buffer.HiByte;
      l:=0; Inc(j);
      Buffer.Word:=0;
    end else begin
      Buffer.Word:=Buffer.HiByte;
    end;
  end;

  var
    i:tBaseNodeIndex;
begin
  Buffer.Word:=0;
  j:=0; l:=0;
  PSelf:=@Self;
  PSelf^.lSizeInNodes:=TreeSize;
  for i:=Low(i) to TreeSize do begin
     PackRef(Tree[i].UpperNodes.Left);
     PackRef(Tree[i].UpperNodes.Right);
  end;
  if l>0 then begin
    PSelf^.Data[j]:=Buffer.LoByte;
  end;
end;

{ Распаковывает дерево }
procedure tPackedTree.UnPackS(var Tree:tTreeData);
  var
    Buffer:tTreePackBuffer;
    j:tPackedTreeSize;
    l:0..16;
    PSelf:^tPackedTree;
    TreeSize:tBaseNodeIndex;

  procedure UnPackRef(var R:tNodeReference);
    type
      PWord=^word;
  begin
     if l=0 then begin
       Buffer.Word:=PWord(@PSelf^.Data[j])^;
       Inc(j); l:=16;
     end else if l<9 then begin
       Buffer.Word:=Buffer.Word or (word(PSelf^.Data[j]) shl l);
       Inc(l,8);
     end;
     Inc(j);
     R:=Buffer.Word and $1FF;
     Buffer.Word:=Buffer.Word shr 9;
     Dec(l,9);
  end;

  var
    i:tBaseNodeIndex;
begin
  Buffer.Word:=0;
  j:=0;
  l:=0;
  PSelf:=@Self;
  TreeSize:=SizeInNodes;
  for i:=Low(i) to TreeSize do begin
     UnPackRef(Tree[i].UpperNodes.Left);
     UnPackRef(Tree[i].UpperNodes.Right);
  end;
end;

{ Упаковывает дерево }
procedure tPackedTree.PackA;
assembler;
{$IfNDef Delphi}
  asm
    push ds
    cld

    les di,Self
    mov al,TreeSize
    stosb
    or al,al; jz @Cont1
    mov bl,al; xor bh,bh; shl bx,1
    lds si,Tree
    xor cx,cx
    xor dl,dl
    @CopyLoop:
       lodsw
       shl ax,cl
       or al,dl
       stosb
       mov dl,ah
       inc cl
       cmp cl,8; jb @Cont
	 mov al,dl
	 stosb
	 xor cl,cl
	 xor dl,dl
       @Cont:
       dec bx
    jnz @CopyLoop

    jcxz @Cont1
      mov al,dl
      stosb
    @Cont1:

    pop ds
  end;
(*  asm
    push ds
    cld

    les di,Self
    mov al,TreeSize
    stosb
    or al,al; jz @Cont1
    mov bl,al; xor bh,bh; shl bx,1
    lds si,Tree
    xor cx,cx
    xor al,al
    @CopyLoop:
       mov dl,al
       lodsw
       shl ax,cl
       or al,dl
       stosb
       mov al,ah
       inc cl
       cmp cl,8; jb @Cont
	 stosb
	 xor cl,cl
	 xor al,al
       @Cont:
       dec bx
    jnz @CopyLoop

    jcxz @Cont1
      stosb
    @Cont1:

    pop ds
  end;*)
{$Else IfNDef Delphi}
  asm
    push esi; push edi; push ebx
    mov esi,Tree
    mov edi,Self{.lSizeInNodes}
    mov al,TreeSize
    stosb
    or al,al; jz @Cont1
    {mov bl,al; xor bh,bh;} movzx bx,al; shl bx,1
    xor cx,cx
    xor al,al
    @CopyLoop:
       mov dl,al
       lodsw
       shl ax,cl
       or al,dl
       stosb
       mov al,ah
       inc cl
       cmp cl,8; jb @Cont
	 stosb
	 xor cl,cl
	 xor al,al
       @Cont:
       dec bx
    jnz @CopyLoop

    jcxz @Cont1
      stosb
    @Cont1:
    pop ebx; pop edi; pop esi
  end;
{$EndIf NDef Delphi}

{ Распаковывает дерево }
procedure tPackedTree.UnPackA;
assembler;
{$IfNDef Delphi}
  asm
    push ds
    cld

    lds si,Self
    lodsb
    or al,al; jz @Exit
    mov bl,al; xor bh,bh; shl bx,1 {bx:=TreeSize*2}
    les di,Tree

    @CopyLoop0:
    mov cl,8
    lodsb
    mov dl,al
    @CopyLoop:
       xor ah,ah
       lodsb
       shl ax,cl
       mov dh,ah
       and ah,1
       or al,dl
       stosw
    dec bx; jz @Exit
       shr dx,9
    dec cl; jnz @CopyLoop
    jmp @CopyLoop0

    @Exit:

    pop ds
  end;
{$Else IfNDef Delphi}
  asm
    push esi; push edi; push ebx
    mov esi,Self
    lodsb
    or al,al; jz @Exit
    movzx bx,al; shl bx,1 {bx:=TreeSize*2}
    mov edi,Tree

    @CopyLoop0:
    mov cl,8
    lodsb
    mov dl,al
    @CopyLoop:
       xor ah,ah
       lodsb
       shl ax,cl
       mov dh,ah
       and ah,1
       or al,dl
       stosw
    dec bx; jz @Exit
       shr dx,9
    dec cl; jnz @CopyLoop
    jmp @CopyLoop0

    @Exit:
    pop ebx; pop edi; pop esi
  end;
{$EndIf NDef Delphi}

{ Вычисляет размер упакованного дерева в байтах }
function CalculateSizeOfPackedTreeInBytes;
begin
  {Размер_в_БИТАХ=Число_узлов*(2_ссылки_на_узел)*(9_бит_на_ссылку)+
		  +(8_бит_на_длину_дерева);

  Размер_в_БАЙТАХ=(Размер_в_БИТАХ+(7_бит_для_правильного_округления) div (8_бит_в_байте)}
  CalculateSizeOfPackedTreeInBytes:=(TreeSizeInNodes*18+15) div 8;
end;

function SizeOfPackedTreeInBytes(const TreeIndexes:tTreeIndexes):word;
begin
  SizeOfPackedTreeInBytes:=CalculateSizeOfPackedTreeInBytes(SizeOfTreeInNodes(TreeIndexes));
end;

{ Инициализирует массив индексов }
procedure InitIndexes(var Indexes:tIndexes);
{$IfNDef Asm}
  var i:tNodeIndex;
{$EndIf NDef Asm}
  const
    cHighI=High(tNodeIndex);
begin
{$IfNDef Asm}
  for i:=Low(i) to High(i) do Indexes[i]:=i;
{$Else IfNDef Asm}
  {$IfNDef Delphi}
  asm
    mov ax,cHighI
    les di,Indexes
    add di,ax; add di,ax
    std
    @loop:
      stosw; dec ax
    jnz @loop
    stosw
  end;
  {$Else IfNDef Delphi}
  asm
    push edi
    xor ecx,ecx; mov cx,cHighI
    mov edi,Indexes
    xor ax,ax
    @loop:
      stosw; inc ax
    loop @loop
    stosw
    pop edi
  end;
  {$EndIf NDef Delphi}
{$EndIf NDef Asm}
end;

{ Инициализирует массив БАЗОВЫХ индексов }
procedure InitBaseIndexes(var Indexes:tBaseIndexes);
{$IfNDef Asm}
  var i:tBaseNodeIndex;
{$EndIf NDef Asm}
  const
    cHighI=High(tBaseNodeIndex);
begin
{$IfNDef Asm}
  for i:=Low(i) to High(i) do Indexes[i]:=i;
{$Else IfNDef Asm}
  {$IfNDef Delphi}
  asm
    mov ax,cHighI
    les di,Indexes
    add di,ax
    std
    @loop:
      stosb; dec ax
    jnz @loop
    stosb
  end;
  {$Else IfNDef Delphi}
  asm
{    push edi
    mov eax,cHighI
    mov edi,Indexes
    add edi,eax
    std
    @loop:
      stosb; dec al
    jnz @loop
    stosb
    cld
    pop edi}

    push edi
    mov ecx,cHighI
    mov edi,Indexes
    xor al,al
    @loop:
      stosb; inc al
    loop @loop
    stosb
    pop edi
  end;
  {$EndIf NDef Delphi}
{$EndIf NDef Asm}
end;

{$IfNDef Delphi}
function GetTickCount:longint;
assembler;
asm
  mov es,Seg0040; mov bx,06Ch
  mov ax,es:[bx]
  mov cx,es:[bx][2]
  mov bx,55
  mul bx
  xchg cx,ax; mov si,dx
  mul bx
  mov dx,si; add dx,ax
  mov ax,cx
end;

function WaitNextTickCount:longint;
assembler;
asm
  mov es,Seg0040; mov bx,06Ch
  mov al,es:[bx]
  @loop:
    cmp al,es:[bx]
  je @loop
  jmp GetTickCount
end;
{$EndIf NDef Delphi}

END.