{ Реализация базовых функций для сжатия Хаффмана
   1) Подсчет частот вхождений для буфера - "CountBytesXXXX".
   2) Построение дерева для буфера - "BuildTreeXXXX".
   3) Вычисление кодов для буфера - "DefineCodesXXXX".
   4) Кодировка буфера - "EncodeXXXX".
   5) Декодировка буфера - "DecodeXXXX"..

   В этот файл вынесены основные функции метода Хаффмана.
}
{---------------------------------------------------------------------------
(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 HuffBase;

INTERFACE
  USES HufTypes {$IFDEF LogCoding}, DHBaseDb {$EndIF DEF LogCoding};

type
  tProcedure=(pAll,
	      pCountBytes,
	      pDefineCodes,
	      pBuildTree,
	      pEncode,
	      pDecode
  );

  tProcType=(ptSimple, ptSimpleAsm, ptAdvanced, ptAdvancedAsm);

{ Считает количество байт с различными значениями в массиве Buffer}
  tCountBytes=procedure(
	       const Buffer;
		     Size:tBufferIndex;
	       var   NodesData:tNodesData
); {$IfDef Delphi}register;{$EndIf}

{ Вычисляет коды для байтов рекурсивным обходом дерева (от корня к исходным узлам) }
  tDefineCodes=procedure (
		 const Nodes:tNodes;
		 var   Codes:tCodes;
		       Root:tNodeIndex
);

{ Строит дерево по текущим частотам }
  tBuildTree=procedure (
	       var   Nodes:tNodes;
	       var   NodesData:tNodesData;
	       var   TreeIndexes:tTreeIndexes
);

{Кодирует буфер InBuf в OutBuf, возвращает размер кода OutSize.
Размер, зарезервированный под OutBuf, должен быть не меньше CompressedSize }
  tEncode=procedure (
	    const InBuf;
		  Size:tBufferIndex;
	    var   OutBuf;
		  OutBufMaxSize:tBufferIndex;
	    var   OutSize:tBufferIndex;
	    var   Codes:tCodes
); {$IfDef Delphi}register;{$EndIf}

{ Декодирует буфер InBuf в OutBuf. Size - размер исходного (несжатого) буфера.
Размер, зарезервированный под OutBuf, должен быть не меньше Size }
  tDecode=procedure(
	    const InBuf;
	    var   OutBuf;
		  Size:tBufferIndex;
	    const Nodes:tNodes;
		  Root:tNodeIndex
);

var
  CountBytes:tCountBytes;
  DefineCodes:tDefineCodes;
  BuildTree:tBuildTree;
  Encode:tEncode;
  Decode:tDecode;

procedure DefineCodesDirect(
	    const Nodes:tNodes;
	    const NodesData:tNodesData;
	    var   Codes:tCodes;
		  Root:tNodeIndex
);
function FindOptimalSize(
  const InBuf;
	SizeMin,
	SizeMax,
	SizeStep:tBufferIndex;
  var   Nodes:tNodes;
  var   NodesData:tNodesData;
  var   Codes:tCodes
):tBufferIndex;

procedure ProcTypeSet(p:tProcedure; pt:tProcType);
function  ProcTypeGet(p:tProcedure):tProcType;

IMPLEMENTATION
{$F+}
  USES HuffSupp, uMiscFun, xStrings;

{  const gCnt:word=0;
  var f:text;
  var fok:text;}

function FindOptimalSize;
  var
    PackedSize,InitialSize:tBufferIndex; r,minr:integer;
    i,i0,OptSize,szc:tBufferIndex;
    TreeIndexes:tTreeIndexes;
  const
    cScale=10000;
begin
  if SizeStep<=0 then SizeStep:=SizeMax div 100;
  if SizeStep<=0 then SizeStep:=1;
  szc:=SizeMax+SizeStep;
  minr:=2*cScale;
  OptSize:=SizeMax;
  i0:=Low(i0);
  i:=SizeMin;
  ClearNodes(Nodes);
  ClearNodesData(NodesData);
  while i<=SizeMax do begin
    { строим дерево Хаффмана }
    CountBytes(tBuffer(InBuf)[i0],i-i0,NodesData);
    BuildTree(Nodes,NodesData,TreeIndexes);
    DefineCodes(Nodes,Codes,TreeIndexes.Root);
    { размер упакованных данных }
    PackedSize:=CompressedSize(NodesData,Codes)*SizeOf(tByte)+ { упакованные данные }
		+SizeOfPackedTreeInBytes(TreeIndexes);      { дерево }
    { исходный размер данных }
    InitialSize:=i*SizeOf(tByte);
    { относительное изменение }
    r:=(LongInt(PackedSize)*10000) div InitialSize;
    if r<minr then begin
      minr:=r;
      OptSize:=i;
    end;
    i0:=i;
    inc(i,SizeStep);
    if (i>SizeMax) and (i<>szc) then
      i:=SizeMax;
  end;
  FindOptimalSize:=OptSize;
end;

{ Считает количество байт с различными значениями в массиве Buffer}
procedure CountBytesSimple(
	    const Buffer;
		  Size:tBufferIndex;
	    var   NodesData:tNodesData
);
  var n:tBufferIndex;
begin
  if Size=0 then Exit;
  for n:=Low(n) to Pred(Low(n)+Size) do begin
    { tBuffer(Buffer)[n] - очередной символ(байт) из байтового массива Buffer.}
    { NodesData[b].Counter - счетчик для символа(байта) b.}
    { Следующая команда извлекает очередной символ(байт)
    из байтового массива Buffer и увеличивает счетчик для него на 1.
    ПРИМЕЧАНИЕ: Inc(x) <=> x:=x+1 }
    Inc(NodesData[tBuffer(Buffer)[n]].Counter);
  end;
end;

{ Считает количество байт с различными значениями в массиве Buffer}
  {$IfNDef Delphi}
procedure CountBytesSimpleAsm(
	    const Buffer;
		  Size:tBufferIndex;
	    var   NodesData:tNodesData
); assembler;
  type
    tCountersArray=array[tBaseNodeIndex] of tBufferIndex;
  var
    Counters:tCountersArray;
  asm
    cmp Size,0; je @Exit
    cld
    { обнуление локальных счетчиков }
    mov cx,cBaseNodeCount
    lea di,Counters; mov ax,ss; mov es,ax
    xor ax,ax
    rep stosw

    { считаем в локальных счетчиках }
    mov cx,Size
    mov dx,ds
    lds si,Buffer
    lea di,Counters
    @CountLoop:
       lodsb
       xor ah,ah
       shl ax,1
       mov bx,ax
       inc tBufferIndex(es:[di][bx])
    loop @CountLoop

    { переписываем из локальных счетчиков в глобальные }
    mov cx,cBaseNodeCount
    lea si,Counters; mov ax,ss; mov ds,ax
    les di,NodesData
    @loop:
       movsw
       add di,2
    loop @loop
    mov ds,dx
    @Exit:
  end;
{$Else IfNDef Delphi}
procedure CountBytesSimpleAsm(
	    const Buffer; {EAX}
		  Size:tBufferIndex; {EDX}
	    var   NodesData:tNodesData {ECX}
);
register; assembler;
  asm
    push esi; push ebx
    mov esi,Buffer
    xchg edx,ecx
    xor eax,eax
    @loop:
       lodsb
       xor ah,ah
       shl eax,3
       inc tNodeData([edx][eax]).Counter
    loop @loop
    pop ebx; pop esi
  end;
{$EndIf NDef Delphi}


{ Строит дерево по текущим частотам методом сортировки слиянием }
procedure BuildTreeAdvanced(
	    var   Nodes:tNodes;
	    var   NodesData:tNodesData;
	    var   TreeIndexes:tTreeIndexes
);

  var
    Indexes:tBaseIndexes; { Indexes массив индексов узлов
			(ссылок на узлы в массиве Nodes) -
			упорядоченный список узлов по возрастанию
			частот вхождений
			NodesData[ Indexes[i] ].Counter<=NodesData[ Indexes[i+1] ].Counter
		      }

   { Ищет место для нового узла в диапазоне il..ir
   методом деления отрезка пополам. }
   function FindPlace(il,ir:tBaseNodeIndex; Counter:tFriquency):tIndex;
      var im:tIndex;
   begin
//     writeln('il=', il,' ir=',ir);
     while (il<ir) do begin
       im:=(il+ir) shr 1; { im:=(il+ir) div 2 }
       if NodesData[Indexes[im]].Counter>Counter then
	 ir:=im
       else
	 il:=Succ(im);
    end;
//    writeln('Counter=', Counter,' NodesData[Indexes[ir]].Counter=',NodesData[Indexes[ir]].Counter);
    FindPlace:=ir;
  end;

  var
    UpLeftNode, UpRightNode:tNodeIndex;
    iFirst, iLast, iNextNew:tIndex;
    NewCounter, CounterN, CounterF:tFriquency;
    EOP:boolean;
begin
   {$IFDEF LogCoding}
      writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','BuildTreeAdvanced ');
   {$EndIF DEF LogCoding}

  { инициализация массива индексов - заполнение массива Indexes[0..255] числами
  Indexes[0]:=0; Indexes[1]:=1;...}
  InitBaseIndexes(Indexes);

  { Строим упорядоченный индекс для исходной таблицы частот}
  for iLast:=1 to Pred(cBaseNodeCount) do begin
    iNextNew:=FindPlace(0, iLast, NodesData[iLast].Counter);
    if iNextNew<iLast then begin
      { Сдвигаем в массиве Indexes элементы с iNextNew по iLast
	на один элемент вправо (в сторону возрастания индекса массива Indexes),
	освобождая элемент iNextNew для вставки значения iLast. }
      System.Move(Indexes[iNextNew],
		  Indexes[Succ(iNextNew)],
		  SizeOf(Indexes[0])*(iLast-iNextNew)
      );
      { Вставляем значение iLast на место в массиве Indexes}
      Indexes[iNextNew]:=iLast;
    end;
  end;
  { по окончании этого цикла в массиве Indexes находится упорядоченная
  последовательность номеров элементов исходной таблицы частот
  (массива NodesData[0..255])}


  { НАЧИНАЕМ СТРОИТЬ ДЕРЕВО }

  { последний узел таблицы = 255}
  iLast:=Pred(cBaseNodeCount);
  { ищем в исходной таблице индексов первый узел с ненулевым счетчиком
  методом деления отрезка пополам (таблица отсортирована по возрастанию)}
  iFirst:=FindPlace(0, iLast, 0);
  { хёыш тёхую ╬─╚═ ёшьтюы т сєЇхЁх => яЁшїюфшЄё  шёяюы№чютрЄ№ тЄюЁющ ЇшъЄштэ√щ...}
  if iFirst=iLast then Dec(iFirst);
  { узел с минимальной длиной кода }
  TreeIndexes.MinCode:=Indexes[iLast];
  { узел с максимальной длиной кода }
  TreeIndexes.MaxCode:=Indexes[iFirst];

  { Cтроим дерево, последовательно добавляя узлы, пока таблица содержит
  более одного узла.
    Заметим, что Indexes[iFirst..255] = базовая таблица частот,
  отсортированная по возрастанию, из которой исключены байты с
  нулевыми счетчиками.
    При генерации дерева, объединение узлов порождает упорядоченную по
  возрастанию частот последовательность в области доп. узлов [256..511].
    Это позволяет отказаться от сортировки массива Indexes при добавлении
  нового узла и использовать что-то вроде сортировки слиянием.
    Имеем:
  1) упорядоченную последовательность в Indexes[iFirst..255];
  2) упорядоченную последовательность в [256..iLast];
  При создании нового узла надо выбрать два узла с минимальными счетчиками.
  Для этого достаточно двух сравнений первых элементов из
  Indexes[iFirst..255] и последовательности новых узлов в [iNextNew..iLast]
  }

  { инициализируем две последовательности:
  1. упорядоченная посл. узлов исходной таблицы;
  2. посл. новых узлов. }

  { добавляем в таблицу новый узел }
  iLast:=cBaseNodeCount;
  { выбираем минимальные узлы для объединения в новый узел }
  UpLeftNode:=Indexes[iFirst];
  Inc(iFirst);
  UpRightNode:=Indexes[iFirst];
  Inc(iFirst);
  { и исключаем эти узлы (первый и второй) из текущей таблицы }

  with Nodes[cBaseNodeCount] do begin
    { запоминаем левый предыдущий узел дерева }
    UpperNodes.Left:=UpLeftNode;
    { запоминаем правый предыдущий узел дерева}
    UpperNodes.Right:=UpRightNode;
  end;
  { запоминаем сумму счетчиков частоты вхождений }
  NodesData[cBaseNodeCount].Counter:=NodesData[UpLeftNode].Counter+NodesData[UpRightNode].Counter;

  { устанавливаем для предыдущих узлов ссылки на следующий узел дерева }
  NodesData[UpLeftNode].NextNode:=iLast;
  NodesData[UpRightNode].NextNode:=iLast;

  {устанавливаем нижн. границу iNextNew..iLast для второй последовательности}
  iNextNew:=cBaseNodeCount;
  while iFirst<cBaseNodeCount do begin { пока не пуста базовая таблица частот }
      { добавляем в таблицу новый узел }
      Inc(iLast);

    { выбираем минимальные узлы для объединения в новый узел }

      { значение 1-го счетчика 2-й последовательности
      сравниваем со значеним 1-го счетчика 1-й последовательности }
      CounterN:=NodesData[iNextNew].Counter;
      CounterF:=NodesData[Indexes[iFirst]].Counter;
      if CounterN<CounterF then begin
	{ если значение 1-го счетчика 2-й последовательности меньше, то
	выбираем его как первый (левый) узел для слияния }
	UpLeftNode:=iNextNew;
	{ и исключаем этот узел из 2-й последовательности }
	Inc(iNextNew);
	NewCounter:=CounterN;
	{ проверяем окончание последовательности 2}
	EOP:=(iNextNew=iLast);
	if EOP then begin
	  { если послед. 2 закончилась, то выбираем  1-й узел
	  1-й последовательности как второй (правый) узел для слияния }
	  UpRightNode:=Indexes[iFirst];
	  { и заканчиваем цикл слияния }
	  Inc(iFirst);
	end else begin
	  CounterN:=NodesData[iNextNew].Counter;
	end;
      end else begin
	{ если значение 1-го счетчика 1-й последовательности меньше, то
	выбираем его как первый (левый) узел для слияния }
	UpLeftNode:=Indexes[iFirst];
	{ и исключаем этот узел из 1-й последовательности }
	Inc(iFirst);
	NewCounter:=CounterF;
	{ проверяем окончание последовательности 1}
	EOP:=(iFirst=cBaseNodeCount);
	if EOP then begin
	  { если послед. 1 закончилась, то выбираем  1-й узел
	  2-й последовательности как второй (правый) узел для слияния }
	  UpRightNode:=iNextNew;
	  { и исключаем этот узел из 2-й последовательности }
	  Inc(iNextNew);
	  { и заканчиваем построение дерева }
	end else begin
	  CounterF:=NodesData[Indexes[iFirst]].Counter;
	end;
      end;
      if not EOP then begin
	{ если в последовательностях есть узлы, то
	значение 1-го счетчика 2-й последовательности
	сравниваем со значеним 1-го счетчика 1-й последовательности }
	if CounterN<CounterF then begin
	  { если значение 1-го счетчика 2-й последовательности меньше, то
	  выбираем его как как второй (правый) узел для слияния }
	  UpRightNode:=iNextNew;
	  { и исключаем этот узел из 2-й последовательности }
	  Inc(iNextNew);
	  Inc(NewCounter,CounterN);
	end else begin
	  { иначе выбираем 1-й узел
	  1-й последовательности как второй (правый) узел для слияния }
	  UpRightNode:=Indexes[iFirst];
	  Inc(iFirst);
	  Inc(NewCounter,CounterF);
	end;
      end else begin
	Inc(NewCounter, NodesData[UpRightNode].Counter);
      end;
   {$IFDEF LogCoding}
      writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','UpLeftNode=', UpLeftNode);
      writeln(DHBaseDb.f_log^, DHBaseDb.GetN,': ','UpRightNode=',UpRightNode);
   {$EndIF DEF LogCoding}

      with Nodes[iLast] do begin
	{ запоминаем левый предыдущий узел дерева }
	UpperNodes.Left:=UpLeftNode;
	{ запоминаем правый предыдущий узел дерева}
	UpperNodes.Right:=UpRightNode;
      end;
      { запоминаем сумму счетчиков частоты вхождений }
      NodesData[iLast].Counter:=NewCounter;

      { устанавливаем для предыдущих узлов ссылки на следующий узел дерева }
      NodesData[UpLeftNode].NextNode:=iLast;
      NodesData[UpRightNode].NextNode:=iLast;

  end;

  { слияние закончено - дальше все просто }
  while (iNextNew<iLast) do begin { пока не пуста 2 посл. }
      { добавляем в таблицу новый узел }
      Inc(iLast);

      UpLeftNode:=iNextNew;
      { и исключаем этот узел из 2-й последовательности }
      Inc(iNextNew);

      UpRightNode:=iNextNew;
      { и исключаем этот узел из 2-й последовательности }
      Inc(iNextNew);

      with Nodes[iLast] do begin
	{ запоминаем левый предыдущий узел дерева }
	UpperNodes.Left:=UpLeftNode;
	{ запоминаем правый предыдущий узел дерева}
	UpperNodes.Right:=UpRightNode;
      end;
      { запоминаем сумму счетчиков частоты вхождений }
      NodesData[iLast].Counter:=NodesData[UpLeftNode].Counter+NodesData[UpRightNode].Counter;

      { устанавливаем для предыдущих узлов ссылки на следующий узел дерева }
      NodesData[UpLeftNode].NextNode:=iLast;
      NodesData[UpRightNode].NextNode:=iLast;
  end;
  { запоминаем номер корневого узла }
  TreeIndexes.Root:=iLast;
end;


procedure BuildTreeSimple(
	    var   Nodes:tNodes;
	    var   NodesData:tNodesData;
	    var   TreeIndexes:tTreeIndexes
);

  var
    Indexes:tIndexes; { Indexes массив индексов узлов
			(ссылок на узлы в массиве Nodes) -
			упорядоченный список узлов по возрастанию
			частот вхождений
			NodesData[ Indexes[i] ].Counter<=NodesData[ Indexes[i+1] ].Counter
		      }

   { Ищет место для нового узла в диапазоне il..ir
   методом деления отрезка пополам. }
   function FindPlace(il,ir:tIndex; Counter:tFriquency):tIndex;
      var im:tIndex;
   begin
     while (il<ir) do begin
       im:=(il+ir) shr 1; { im:=(il+ir) div 2 }
       if NodesData[Indexes[im]].Counter>Counter then
	 ir:=im
       else
	 il:=Succ(im);
    end;
    FindPlace:=ir;
  end;

  var
    UpLeftNode,UpRightNode:tNodeIndex;
    NewCounter:tFriquency;
    iFirst,iLast,NodePlace:tIndex;
begin
  { инициализация массива индексов - заполнение массива Indexes числами
  Indexes[0]:=0; Indexes[1]:=1;...}
  InitIndexes(Indexes);

  { Строим упорядоченный индекс для исходной таблицы частот}
  for iLast:=1 to Pred(cBaseNodeCount) do begin
    NodePlace:=FindPlace(0, iLast, NodesData[iLast].Counter);
    if NodePlace<iLast then begin
      { Сдвигаем в массиве Indexes элементы с NodePlace по iLast
	на один элемент вправо (в сторону возрастания индекса массива Indexes),
	освобождая элемент NodePlace для вставки значения iLast. }
      System.Move(Indexes[NodePlace],
		  Indexes[Succ(NodePlace)],
		  SizeOf(Indexes[0])*(iLast-NodePlace)
      );
      { Вставляем значение iLast на место в массиве Indexes}
      Indexes[NodePlace]:=iLast;
    end;
  end;
  { по окончании этого цикла в массиве Indexes находится упорядоченная
  последоватеьность номеров элементов исходной таблицы частот
  (массива NodesData[0..255])}


  { НАЧИНАЕМ СТРОИТЬ ДЕРЕВО }

  { последний узел таблицы = 255}
  iLast:=Pred(cBaseNodeCount);
  { ищем в исходной таблице индексов первый узел с ненулевым счетчиком
  методом деления отрезка пополам (таблица отсортирована по возрастанию)}
  iFirst:=FindPlace(0, iLast, 0);
  { хёыш тёхую ╬─╚═ ёшьтюы т сєЇхЁх => яЁшїюфшЄё  шёяюы№чютрЄ№ тЄюЁющ ЇшъЄштэ√щ...}
  if iFirst=iLast then Dec(iFirst);
  { узел с минимальной длиной кода }
  TreeIndexes.MinCode:=Indexes[iLast];
  { узел с максимальной длиной кода }
  TreeIndexes.MaxCode:=Indexes[iFirst];

  { Cтроим дерево, последовательно добавляя узлы, пока таблица содержит
  более одного узла.
   Indexes[First..Last] = текущая таблица частот }
  while iFirst<iLast do begin   { добавить узел }
      { выбираем первый и второй узлы текущей таблицы для объединения в новый
      узел, т.к. они имеют минимальные значения счетчиков
      (таблица отсортирована по возрастанию)}
      UpLeftNode:=Indexes[iFirst];
      Inc(iFirst);
      UpRightNode:=Indexes[iFirst];
      Inc(iFirst);
      { и исключаем эти узлы (первый и второй) из текущей таблицы }

      { добавляем в таблицу новый узел }
      Inc(iLast);

      { вычисляем сумму счетчиков частоты вхождений}
      NewCounter:=NodesData[UpLeftNode].Counter+NodesData[UpRightNode].Counter;

      with Nodes[iLast] do begin
	{ запоминаем левый предыдущий узел дерева }
	UpperNodes.Left:=UpLeftNode;
	{ запоминаем правый предыдущий узел дерева}
	UpperNodes.Right:=UpRightNode;
      end;
      { запоминаем сумму счетчиков частоты вхождений }
      NodesData[iLast].Counter:=NewCounter;

      { устанавливаем для предыдущих узлов ссылки на следующий узел дерева }
      NodesData[UpLeftNode].NextNode:=iLast;
      NodesData[UpRightNode].NextNode:=iLast;

      { вставляем новый узел на нужное место текущей таблицы индексов
      для сохранения упорядоченности таблицы по возрастанию:
	1) поиск места вставки методом деления отрезка пополам }
      NodePlace:=FindPlace(iFirst, iLast, NewCounter);
      { 2) вставка индекса узла на место}
      if NodePlace<iLast then begin
	{ Сдвигаем в массиве Indexes элементы с NodePlace по iLast
	  на один элемент вправо (в сторону возрастания индекса массива Indexes),
	  освобождая элемент NodePlace для вставки значения iLast. }
	System.Move(Indexes[NodePlace],
		    Indexes[Succ(NodePlace)],
		    SizeOf(Indexes[0])*(iLast-NodePlace)
	);
	{ Вставляем значение iLast на место в массиве Indexes}
	Indexes[NodePlace]:=iLast;
      end;
  end;
  { запоминаем номер корневого узла }
  TreeIndexes.Root:=iLast;
end;

{ Строит дерево по текущим частотам }
procedure BuildTreeSimpleAsm(
	    var   Nodes:tNodes;
	    var   NodesData:tNodesData;
	    var   TreeIndexes:tTreeIndexes);

 { массив индексов узлов (ссылок на узлы в массиве Nodes) -
  упорядоченный список узлов по возрастанию частот вхождений }
  var
    Indexes:tIndexes;

   { Ищет место для нового узла в диапазоне il..ir
   методом деления отрезка пополам. }
   function FindPlace(il,ir:tIndex; Counter:tFriquency):tIndex;
      var im:tIndex;
   begin
     while (il<ir) do begin
       im:=(il+ir) shr 1; { im:=(il+ir) div 2;}
       if NodesData[Indexes[im]].Counter>Counter then
	 ir:=im
       else
	 il:=Succ(im);
    end;
    FindPlace:=ir;
  end;

  var
    UpLeftNode,UpRightNode:tNodeIndex;
    NewCounter:tFriquency;
    iFirst,iLast,NodePlace:tIndex;
  const
    cSizeOfTNodeIndex=SizeOf(tNodeIndex);

begin
  { Инициализация массива индексов - заполнение массива Indexes числами
  Indexes[0]:=0; Indexes[1]:=1;...}
  InitIndexes(Indexes);

  { Строим упорядоченный индекс для исходной таблицы }
  for iLast:=Succ(Low(iLast)) to Pred(cBaseNodeCount) do begin
    NodePlace:=FindPlace(0, iLast, NodesData[iLast].Counter);
    {$IfNDef Delphi}
    asm
      mov ax,iLast; mov cx,ax; sub cx,NodePlace
      jbe @Skip
	mov dx,ss; mov es,dx
	lea si,Indexes
	add si,ax; add si,ax; mov di,si; sub si,cSizeOfTNodeIndex
	std
	rep SegSS movsw
	stosw
      @Skip:
    end;
    {$Else IfNDef Delphi}
    asm
      movzx eax,iLast; mov ecx,eax; sub cx,NodePlace
      jbe @Skip
	push esi; push edi
	lea esi,Indexes
	add esi,eax; add esi,eax; mov edi,esi; sub esi,cSizeOfTNodeIndex
	std
	rep movsw
	stosw
	cld
	pop edi; pop esi
      @Skip:
    end;
    {$EndIf NDef Delphi}
  end;

  { последний узел таблицы = 255}
  iLast:=Pred(cBaseNodeCount);
  { ищем в исходной таблице индексов первый узел с ненулевым счетчиком
  методом деления отрезка пополам (таблица отсортирована по возрастанию)}
  iFirst:=FindPlace(0, iLast, 0);
  { узел с минимальной длиной кода }
  TreeIndexes.MinCode:=Indexes[iLast];
  { узел с максимальной длиной кода }
  TreeIndexes.MaxCode:=Indexes[iFirst];

  { Если весь буфер состоит из одного и того же байта, то дерево не будет
  построено и далее возникнет ошибка. Для ликвидации этого добавляем
  фальшивый узел, это не приведет к изменению длины кодированного буфера.}
  if iLast=iFirst then begin
    Dec(iFirst);
  end;

  { Cтроим дерево, последовательно добавляя узлы, пока таблица содержит
  более одного узла.
   Indexes[First..Last] = текущая таблица частот }
  while iFirst<iLast do begin   { добавить узел }
      { выбираем первый и второй узлы текущей таблицы для объединения в новый
      узел, т.к. они имеют минимальные значения счетчиков
      (таблица отсортирована по возрастанию)}
      UpLeftNode:=Indexes[iFirst];
      Inc(iFirst);
      UpRightNode:=Indexes[iFirst];
      Inc(iFirst);
      { и исключаем эти узлы (первый и второй) из текущей таблицы }
{      writeln(f,UpLeftNode,', ',UpRightNode);}

      { добавляем в таблицу новый узел }
      Inc(iLast);

      { вычисляем сумму счетчиков частоты вхождений}
      NewCounter:=NodesData[UpLeftNode].Counter+NodesData[UpRightNode].Counter;

      with Nodes[iLast] do begin
	{ запоминаем левый предыдущий узел дерева }
	UpperNodes.Left:=UpLeftNode;
	{ запоминаем правый предыдущий узел дерева}
	UpperNodes.Right:=UpRightNode;
      end;
      { запоминаем сумму счетчиков частоты вхождений }
      NodesData[iLast].Counter:=NewCounter;

      { устанавливаем для предыдущих узлов ссылки на следующий узел дерева }
      NodesData[UpLeftNode].NextNode:=iLast;
      NodesData[UpRightNode].NextNode:=iLast;

      { вставляем новый узел на нужное место текущей таблицы индексов
      для сохранения упорядоченности таблицы по возрастанию:
	1) поиск места вставки методом деления отрезка пополам }
      NodePlace:=FindPlace(iFirst, iLast, NewCounter);
      { 2) вставка индекса узла на место}
       {$IfNDef Delphi}
	asm
	  mov ax,iLast; mov cx,ax; sub cx,NodePlace
	  jbe @Skip
	    mov dx,ss; mov es,dx
	    lea si,Indexes
	    add si,ax; add si,ax; mov di,si; sub si,cSizeOfTNodeIndex
	    std
	    rep SegSS movsw
	    stosw
	  @Skip:
	end;
       {$Else IfNDef Delphi}
	asm
	  movzx eax,iLast; mov ecx,eax; sub cx,NodePlace
	  jbe @Skip
	    push esi; push edi
	    lea esi,Indexes
	    add esi,eax; add esi,eax; mov edi,esi; sub esi,cSizeOfTNodeIndex
	    std
	    rep movsw
	    stosw
	    cld
	    pop edi; pop esi
	  @Skip:
	end;
       {$EndIf NDef Delphi}
  end;
  TreeIndexes.Root:=iLast;
{  Flush(f);}
end;

{ Вычисляет коды для байтов прямым обходом дерева (от исходного узла к корню ) }
procedure DefineCodesDirect(
	    const Nodes:tNodes;
	    const NodesData:tNodesData;
	    var   Codes:tCodes;
		  Root:tNodeIndex);
  var
    i:TBaseNodeIndex;
    n:TNodeIndex;
    nn:tNodeReference;
    c:tCode;
    lc:tCodeLength;
    bit:tByte;
begin
  for i:=Low(i){=0} to High(i){255} do begin
    if NodesData[i].Counter=0 then begin
      { если счетчик байта i нулевой => кода для байта нет (и не надо) }
      Codes[i].Length:=0;
    end else begin
      { если счетчик байта i НЕнулевой => надо считать кода для байта  }
      n:=i;
      lc:=0;
      { Считаем длину кода }
      repeat
	{ Получаем ссылку на следующий узел в дереве. }
	n:=NodesData[n].NextNode;
	{ Увеличиваем длину для кодовой цепочки. }
	Inc(lc);
	{ Повторяем, пока не дойдем до корневого узла дерева. }
      until (n=Root);
      { записываем длину кода }
      c.Length:=lc;
      { обнуляем ячейку для записи кода }
      FillMemByByte(c.Code, ((lc+7) shr 3) {(lc+7) div 8}, 0);

      { Вычисляем код }
      n:=i;
      Dec(lc);
      bit:=(1 shl (lc and 7)); { bit:=2^(младшие 3 бита lc)}
      for lc:=lc downto 0 do begin
	{ nn = следующий узел для узла n}
	nn:=NodesData[n].NextNode;
	{ Проверяем является ли данный узел ПРАВЫМ предыдущим узлом для
	следующего, }
	if n=Nodes[nn].UpperNodes.Right then begin
	  { если ДА, то устанавливаем в битовой цепочке 1.}
	  Inc(c.Code.Bytes[(lc shr 3){lc div 8}],bit);
	{$IfOpt R+}
	{ доп. проверка правильности структуры дерева }
	end else if n<>Nodes[nn].UpperNodes.Left then begin
	  RunError(201);
	{$EndIf Opt R+}
	end;
	n:=nn;
	{ сдвигаем 1 вправо в байте bit}
	asm
	  ror bit,1  {bit:=bit shr 1; if bit=0 then bit:=(1 shl 7);}
	end;
      end;
      { Запоминаем вычисленный код. }
      Codes[i]:=c;
    end;
  end;
end;

{ Вычисляет коды для байтов рекурсивным обходом дерева (от корня к исходным узлам) }
procedure DefineCodesSimple(
	    const Nodes:tNodes;
	    var   Codes:tCodes;
		  Root:tNodeIndex
);
  var TmpCode:tCode;

  procedure CodesCalculate(NodeIndex:tNodeIndex);
    var BytePtr:^byte; bit:byte;
  begin
    if NodeIndex<cBaseNodeCount then begin
      { дошли до одного из узлов исходной таблицы - запомнить код }
      Codes[NodeIndex]:=TmpCode;
    end else begin
      { вычислить коды для левого и правого предшествующих узлов }

      { вспомогательные переменные:
	 байт внутри кода, с битом которого оперируем }
      BytePtr:=@TmpCode.Code.Bytes[(TmpCode.Length shr 3)];
      {  бит которым оперируем }
      bit:=(1 shl (TmpCode.Length and 7));

      { увеличить длину кода на 1 - входим в вышележащие узлы }
      Inc(TmpCode.Length);

      { установить бит в 1 - правый узел }
      Inc(BytePtr^,bit);

      { рекурсивный вызов для правого узла }
      CodesCalculate(Nodes[NodeIndex].UpperNodes.Right);

      { убрать бит }
      Dec(BytePtr^,bit);

      { рекурсивный вызов для левого узла }
      CodesCalculate(Nodes[NodeIndex].UpperNodes.Left);

      { уменьшить длину кода на 1 - вышли обратно в нижележащие узлы  }
      Dec(TmpCode.Length);
    end;
  end;

begin
  { обнуление кодов }
  FillMemByByte(Codes,SizeOf(Codes), 0);
  { Вычисление кодов для дерева }
  TmpCode:=cCode0;
  CodesCalculate(Root);
end;


{ Кодирует буфер InBuf в OutBuf, возвращает размер кода в OutSize.
Размер, зарезервированный под OutBuf, должен быть не меньше CompressedSize }

procedure EncodeSimple(
	    const InBuf;  Size:tBufferIndex;
	    var   OutBuf; OutBufMaxSize:tBufferIndex;
	    var   OutSize:tBufferIndex;
	    var   Codes:tCodes
); {$IfDef Delphi}register;{$EndIf}
  type
    tPDByte=^tDByte;
  var
    i,j:tBufferIndex;
    PCode:tPCode;
    PCodeBytes:^tCodeBytes;
    BitsShift:byte;
    CodeLength:tCodeByteIndex;
    n:Pred(Low(CodeLength))..High(CodeLength);
begin
  { размер данных в выходном буфере =0 }
  OutSize:=0;

  { если размер данных во входном буфере =0 - выходим, ибо нечего кодировать }
  if Size=0 then Exit;

  { инициализируем вспомогательные переменные }
  j:=0; { очередной байт в выходном буфере }
  BitsShift:=0; { остаток бит предыдущих кодов, не кратных 8 битам (байту)}

  { очищаем выходной буфер }
  FillMemByByte(OutBuf,OutBufMaxSize,0);

  { начинаем цикл кодирования}
  for i:=Low(i) to Pred(Size) do begin
    { указатель на код для очередного символа из входного буфера }
    PCode:=@Codes[ tBuffer(InBuf)[i] ];
    {$IfOpt R+  Доп. проверка }
    if PCode^.Length=0 then
      RunError(201);
    {$EndIf}
    { длина кода в байтах (исключая неполные) }
    CodeLength:=(PCode^.Length shr 3); { CodeLength:=(PCode^.Length div 8); }
    PCodeBytes:=@PCode^.Code.Bytes;
    { копирование полных байт кода в выходной буфер }
    for n:=Low(tCodeByteIndex) to Low(tCodeByteIndex)+Pred(CodeLength) do begin
      {$IfOpt R+  Доп. проверка }
      if j>=OutBufMaxSize then
	RunError(201);
      {$EndIf}
//      tPDByte(@tBuffer(OutBuf)[j])^:=0;
      Inc( tPDByte(@tBuffer(OutBuf)[j])^, (tDByte(PCodeBytes^[n]) shl BitsShift) );
      inc(j);
    end;
    { копирование остатка бит кода}
    n:=(PCode^.Length and 7); { n:=(PCode^.Length mod 8);}
    if n>0 then begin
      inc(n,BitsShift);
      if n>=cSizeOftByteInBits then begin
	{$IfOpt R+  Доп. проверка }
	 if j>=OutBufMaxSize then
	   RunError(201);
	{$EndIf}
	Inc( tPDByte(@tBuffer(OutBuf)[j])^, (tDByte(PCodeBytes^[CodeLength]) shl BitsShift) );
	inc(j);
	dec(n,cSizeOftByteInBits);
      end else begin
	Inc( tBuffer(OutBuf)[j], (PCodeBytes^[CodeLength] shl BitsShift) );
      end;
      BitsShift:=n;
    end;
  end;
  if BitsShift>0 then begin
    inc(j);
    {$IfOpt R+  Доп. проверка }
    if j>OutBufMaxSize then
      RunError(201);
    {$EndIf}
  end;
  { размер данных в выходном буфере (полные и неполные байты)}
  OutSize:=j;
end;

{$IfNDef Delphi}
type
  tCoderPtrs=array[tBaseNodeIndex] of word;

procedure CalcCodesPtrs(var CodesPtrs:tCoderPtrs; const Codes:tCodes);
assembler;
  const
    cSizeOfCode=SizeOf(tCode);
asm
  mov ax,word(Codes)
  les di,CodesPtrs
  mov cx,256
  cld
  @loop:
    stosw
    add ax,cSizeOfCode
  loop @loop
end;
{$Else IfNDef Delphi}
type
  tCoderPtrs=array[tBaseNodeIndex] of tPCode;

procedure CalcCodesPtrs(var CodesPtrs:tCoderPtrs; const Codes:tCodes);
register; assembler;
  const
    cSizeOfCode=SizeOf(tCode);
asm
  push edi
  mov edi,CodesPtrs
  mov ecx,256
  mov eax,Codes
  @loop:
    stosd
    add eax,cSizeOfCode
  loop @loop
  pop edi
end;
{$EndIf NDef Delphi}

{ Кодирует буфер InBuf в OutBuf, возвращает размер кода в OutSize.
Размер, зарезервированный под OutBuf, должен быть не меньше CompressedSize. }
procedure EncodeSimpleASM(
	    const InBuf;  Size:tBufferIndex;
	    var   OutBuf; OutBufMaxSize:tBufferIndex;
	    var   OutSize:tBufferIndex;
	    var   Codes:tCodes
);
{$IfNDef Delphi}
  var CodesPtrs:tCoderPtrs;
begin
  OutSize:=0;
  if Size=0 then Exit;
  CalcCodesPtrs(CodesPtrs,Codes);
      asm
	push ds
	cld
	{ ES:DI -> выходной буфер,
	глобальное значение для цикла кодирования входного буфера }
	les di,OutBuf
{	mov dx,Size }
	mov dx,word(Codes)[2] { DX:=Seg(Codes) }
	{ очистка вспомогательных переменных:
	   CH=остаток битов кода (< 8 бит);
	   CL=длина остатка битов кода (< 8);
	это глобальные значения для цикла кодирования входного буфера }
	xor cx,cx

	{ Цикл кодирования входного буфера }
	@loop:
	{ DS:SI -> очередной байт во входном буфере }
	  lds si,InBuf
	{ AL:= очередной байт из входного буфера }
	  lodsb
	{ @InBuf -> следующий байт во входном буфере }
	  mov tPointer(InBuf).Ofs,si
	{ DS:SI -> массив кодов Хаффмана }
	  xor ah,ah; shl ax,1; mov si,ax
	  mov ds,dx
	  mov si,word(CodesPtrs[si])
	{ BH = длина кода Хаффмана для текущего байта из входного буфера }
	  mov bl,[si]
	  inc si
	{ DS:SI -> биты кода Хаффмана для текущего байта из входного буфера }

	{ Цикл копирования кода Хаффмана для текущего байта в выходной буфер.}
	  add bl,cl {BL:=длина битовой цепочки для копирования,
			 включая остаток с предыд. байта CL }

	  cmp bl,8; jb @SkipCopyByteLoop
	    shl bx,5 {BH:=BL div 8 - число полных байт }
	    shr bl,5 {BL:= BL mod 8 - число оставшихся бит }
	    { Копирование полных битов кода в буфер OutBuf }
	    @CopyByteLoop:
	      xor ah,ah
	      lodsb
	      shl ax,cl
	      or al,ch
	      stosb
	      mov ch,ah
	      dec bh
	    jnz @CopyByteLoop
	  @SkipCopyByteLoop:

	  cmp bl,cl; jb @SkipLodsb; je @Skip;
	  { Копирование остатка битов кода в CH }
	    lodsb
	    shl al,cl
	    or ch,al
	  @SkipLodsb:
	    mov cl,bl
	  @Skip:
	{ КОНЕЦ цикла копирования кода Хаффмана	для текущего байта.}

	{ вычисление количества оставшихся во входном буфере байтов}
	  dec Size
{	  dec dx}
	{ продолжение кодирования, если еще остались байты во входном буфере }
	jnz @loop

	{ запоминание остатка битов в выходном буфере }
	or cl,cl; jz @SkipRest
	  mov al,ch; stosb
	@SkipRest:
	{ КОНЕЦ Цикла кодирования входного буфера }

	{ вычисление длины выходного буфера }
	sub di,tPointer(OutBuf).Ofs
	lds si,OutSize;	mov [si],di

	pop ds
      end;
      {$IfOpt R+}
      if OutSize>OutBufMaxSize then
	RunError(201);
      {$EndIf}
end;
{$Else IfNDef Delphi}
  register;
  var CodesPtrs:tCoderPtrs;
begin
  OutSize:=0;
  if Size=0 then Exit;
  CalcCodesPtrs(CodesPtrs,Codes);
      asm
	push esi; push edi; push ebx
	cld
	mov edi,OutBuf
	xor ecx,ecx
	xor ebx,ebx
	mov edx,InBuf

	@loop:
	  movzx eax,byte([edx])
	  inc edx

	  shl eax,2
	  mov esi,tPCode(CodesPtrs([eax]))

	  lodsb
	  mov bl,al

	  add bl,cl
	  cmp bl,8; jb @SkipCopyByteLoop
	    shl bx,5
	    shr bl,5
	    @CopyByteLoop:
	      xor ah,ah
	      lodsb
	      shl ax,cl
	      or al,ch
	      stosb
	      mov ch,ah
	      dec bh
	    jnz @CopyByteLoop
	  @SkipCopyByteLoop:

	  cmp bl,cl; jbe @SkipLodsb
	    lodsb
	    shl al,cl
	    or ch,al
	  @SkipLodsb:
	    mov cl,bl

	  dec Size
	jnz @loop
	or cl,cl; jz @SkipRest
	  mov al,ch; stosb
	@SkipRest:

	sub edi,OutBuf
	mov esi,OutSize; mov [esi],edi

	pop ebx; pop edi; pop esi
      end;
      {$IfOpt R+}
      if OutSize>OutBufMaxSize then
	RunError(201);
      {$EndIf}
end;
{$EndIf NDef Delphi}

procedure yEncodeSimple(
	    const InBuf;  Size:tBufferIndex;
	    var   OutBuf; OutBufMaxSize:tBufferIndex;
	    var   OutSize:tBufferIndex;
	    var   Codes:tCodes
); register;
  type
    tPDByte=^tDByte;
  var
    i,j:tBufferIndex;
    PCode:tPCode;
    PCodeBytes:^tCodeBytes;
    BitsShift:byte;
    CodeLength:tCodeByteIndex;
    n:Pred(Low(CodeLength))..High(CodeLength);
begin
  { размер данных в выходном буфере =0 }
  OutSize:=0;

  { если размер данных во входном буфере =0 - выходим, ибо нечего кодировать }
  if Size=0 then Exit;

  { инициализируем вспомогательные переменные }
  j:=0; { очередной байт в выходном буфере }
  BitsShift:=0; { остаток бит предыдущих кодов, не кратных 8 битам (байту)}

  { очищаем выходной буфер }
  FillMemByByte(OutBuf,OutBufMaxSize,0);

  { начинаем цикл кодирования}
  for i:=Low(i) to Pred(Size) do begin
    { указатель на код для очередного символа из входного буфера }
    PCode:=@Codes[ tBuffer(InBuf)[i] ];
    {$IfOpt R+  Доп. проверка }
    if PCode^.Length=0 then
      RunError(201);
    {$EndIf}
    { длина кода в байтах (исключая неполные) }
    CodeLength:=(PCode^.Length shr 3); { CodeLength:=(PCode^.Length div 8); }
    PCodeBytes:=@PCode^.Code.Bytes;
    { копирование полных байт кода в выходной буфер }
    for n:=Low(tCodeByteIndex) to Low(tCodeByteIndex)+Pred(CodeLength) do begin
      {$IfOpt R+  Доп. проверка }
      if j>=OutBufMaxSize then
	RunError(201);
      {$EndIf}
      write(j,' ');
//      tPDByte(@tBuffer(OutBuf)[j])^:=0;
      Inc( tPDByte(@tBuffer(OutBuf)[j])^, (tDByte(PCodeBytes^[n]) shl BitsShift) );
      inc(j);
    end;
    { копирование остатка бит кода}
    n:=(PCode^.Length and 7); { n:=(PCode^.Length mod 8);}
    if n>0 then begin
      inc(n,BitsShift);
      if n>=cSizeOftByteInBits then begin
	{$IfOpt R+  Доп. проверка }
	 if j>=OutBufMaxSize then
	   RunError(201);
	{$EndIf}
	Inc( tPDByte(@tBuffer(OutBuf)[j])^, (tDByte(PCodeBytes^[CodeLength]) shl BitsShift) );
	inc(j);
	dec(n,cSizeOftByteInBits);
      end else begin
	Inc( tBuffer(OutBuf)[j], (PCodeBytes^[CodeLength] shl BitsShift) );
      end;
      BitsShift:=n;
    end;
  end;
  writeln(j);
  if BitsShift>0 then begin
    inc(j);
    {$IfOpt R+  Доп. проверка }
    if j>OutBufMaxSize then
      RunError(201);
    {$EndIf}
  end;
  { размер данных в выходном буфере (полные и неполные байты)}
  OutSize:=j;
end;

{ Декодирует буфер InBuf в OutBuf. Size - размер исходного (несжатого) буфера.
Размер, зарезервированный под OutBuf, должен быть не меньше Size }
procedure DecodeSimple(
	    const InBuf;
	    var   OutBuf;
		  Size:tBufferIndex;
	    const Nodes:tNodes;
		  Root:tNodeIndex
);
{  ПРОСТАЯ ДЕКОДИРОВКА ПРОХОДОМ ПО ДЕРЕВУ }
  var
    j,i:tBufferIndex;
    Node:tNodeIndex;
{    ByteDecoded:boolean;}
    lc:0..8;
    b:byte;

begin
  i:=0; { - индекс для кодированного буфера }
  lc:=0; { - число недекодированных бит в буферной переменной b}
  b:=0;
  { Цикл декодирования выходного буфера. }
  for j:=0 to Pred(Size) do begin { j - индекс для кодированного буфера }
    { Начинаем проход по дереву с корневого узла. }
    Node:=Root;

    repeat
      if lc=0 then begin
            {$IfOpt R+}
              if i>=Size then
	        RunError(201);
            {$EndIf}
      { Считываем очередной байт данных из кодированного (входного) буфера. }
	b:=tBuffer(InBuf)[i];
	Inc(i);
	lc:=8;
      end;

     { Декодировка проходом по дереву. }
      Node:=Nodes[Node].UpperNodes.Refs[(b and 1)];
      {$IfOpt R+}
        if (Node=-1) or (Node>=Root) then
          RunError(201);
      {$EndIf}
      b:=b shr 1;
      Dec(lc);
    until (Node<cBaseNodeCount);
(*
    repeat
      if lc=0 then begin
            {$IfOpt R+}
              if i>=Size then
	        RunError(201);
            {$EndIf}
      { Считываем очередной байт данных из кодированного (входного) буфера. }
	b:=tBuffer(InBuf)[i];
	Inc(i);
	lc:=8;
      end;

      { Декодировка проходом по дереву. }
      repeat
	Node:=Nodes[Node].UpperNodes.Refs[(b and 1)];
	{$IfOpt R+}
	  if (Node=-1) or (Node>=Root) then
	    RunError(201);
	{$EndIf}
	b:=b shr 1;
	Dec(lc);
	ByteDecoded:=(Node<cBaseNodeCount);
      until ByteDecoded or (lc=0);

    until ByteDecoded;
*)
    { Заносим декодированный байт в буфер. }
    tBuffer(OutBuf)[j]:=Node;
  end;
end;

{ Декодирует буфер InBuf в OutBuf. Size - размер исходного (несжатого) буфера.
Размер, зарезервированный под OutBuf, должен быть не меньше Size }
procedure DecodeSimpleASM(
	    const InBuf;
	    var   OutBuf;
		  Size:tBufferIndex;
	    const Nodes:tNodes;
		  Root:tNodeIndex
);
{   АССЕМБЛЕРНАЯ ПРОСТАЯ ДЕКОДИРОВКА ПРОХОДОМ ПО ДЕРЕВУ
   (вручную оптимизированная, но не обгоняет табличную декодировку) }
{$IfNDef Delphi}
begin
  asm
    push ds
    cmp Size,0; jbe @ExitWhile
    { Пока размер декодированного буфера меньше Size}
    cld
    { Указатель на выходной буфер (глобальный для цикла распаковки)}
    les di,OutBuf
  { начинаем проход по дереву с корневого узла }
    mov bx,Root
    @WhileLoop:
      { Считываем очередной байт данных из входного буфера в B. }
      lds si,InBuf

      mov cx,16
      cmp Size,cx; jae @LodsW
	lodsb
	mov cl,8
      jmp @LodsB
      @LodsW:
	lodsw
      @LodsB:
      mov dx,ax
      mov word(InBuf),si

     { Поскольку считывать побитно мы не можем, то обрабатываем байт или слово }
      lds si,Nodes
      @loop:
       { извлекаем очередной бит из считанных данных DX в CF }
	 shr dx,1
       { устанавливаем текущий узел равным соответствующему предыдущему узлу
	 ЛЕВОМУ, если BIT=0 и ПРАВОМУ, если BIT=1
	 rcl bx,2 вычисляет смещение в массиве Nodes:
	 здесь  ds:[dx] -> Nodes;
		BX=CurNode;
		CF=bit.
	 rcl bx,2 эквивалентно (если BX < 2^14) BX:=BX*4+CF*2;
	 ds:[si][bx] -> Nodes[CurNode].UpperNodes.Refs[bit];
	}
	 rcl bx,2
       { BX:=Nodes[CurNode].UpperNodes.Refs[bit] }
	 mov bx,[si][bx]
       { проверяем не является ли текущий узел узлом исходной таблицы
	(CurNode<=255) }
{	 cmp bx,cBaseNodeCount; jae @Cont}
	 or bh,bh; jnz @Cont
	  { если ДА, то записываем соответствующий символ в выходной буфер }
	    mov al,bl
	    stosb
	  { проверяем, не достигнут ли размер декодированного буфера,
	   если ДА, то выходим из цикла }
	   dec Size; jz @ExitWhile
	  { иначе устанавливаем текущий узел равным корневому узлу }
	    mov bx,Root
	 @Cont:
      loop @loop
    jmp @WhileLoop
    @ExitWhile:
    pop ds
  end;
end;
{$Else IfNDef Delphi}
begin
  asm
    push edi; push esi; push ebx
    cmp Size,0; jbe @ExitWhile
    { ╧юър ЁрчьхЁ фхъюфшЁютрээюую сєЇхЁр ьхэ№°х Size}
    xor edx,edx
    xor eax,eax
    { ╙ърчрЄхы№ эр т√їюфэющ сєЇхЁ (уыюсры№э√щ фы  Ўшъыр Ёрёяръютъш)}
    mov edi,OutBuf
    { ╙ърчрЄхы№ эр тїюфэющ сєЇхЁ (уыюсры№э√щ фы  Ўшъыр Ёрёяръютъш)}
    mov esi,InBuf
    { ╙ърчрЄхы№ эр ьрёёшт єчыют фхЁхтр (уыюсры№э√щ фы  Ўшъыр Ёрёяръютъш)}
    mov ebx,Nodes
  { эрўшэрхь яЁюїюф яю фхЁхтє ё ъюЁэхтюую єчыр }
    mov ax,Root
    @WhileLoop:

      { ╤ўшЄ√трхь юўхЁхфэющ срщЄ фрээ√ї шч тїюфэюую сєЇхЁр т B. }
      cmp Size,32; jae @LodsDW
      cmp Size,16; jae @LodsW
	mov dl,[esi]
	mov ecx,8
	inc esi
      jmp @EndLodsX
      @LodsW:
	mov dx,[esi]
	mov ecx,16
	add esi,2
      jmp @EndLodsX
      @LodsDW:
	mov edx,[esi]
	mov ecx,32
	add esi,4
      @EndLodsX:

     { ╧юёъюы№ъє ёўшЄ√трЄ№ яюсшЄэю ь√ эх ьюцхь, Єю юсЁрсрЄ√трхь срщЄ шыш ёыютю }
      @loop:
      { шчтыхърхь юўхЁхфэющ сшЄ шч ёўшЄрээ√ї фрээ√ї DX т CF }
	 shr edx,1
      { єёЄрэртыштрхь Єхъє∙шщ єчхы Ёртэ√ь ёююЄтхЄёЄтє■∙хьє яЁхф√фє∙хьє єчыє
	╦┼┬╬╠╙, хёыш BIT=0 ш ╧╨└┬╬╠╙, хёыш BIT=1
	rcl ax,2 т√ўшёы хЄ ёьх∙хэшх т ьрёёштх Nodes:
	[ebx] -> PNodes^
	CurNode=ax;
	bit=CF;
	rcl ax,2 ¤ътштрыхэЄэю (хёыш AX <= (2^14)) ax:=AX*4+CF*2;
	[ebx][eax] -> Nodes[CurNode].TopNodes.Refs[bit];
	}
	 rcl ax,2
      { AX:=Nodes[CurNode].TopNodes.Refs[bit] }
	 mov ax,[ebx][eax]
      { яЁютхЁ хь эх  ты хЄё  ыш Єхъє∙шщ єчхы єчыюь шёїюфэющ ЄрсышЎ√
      (CurNode<=255) }
       or ah,ah; jnz @Cont
	{ хёыш ─└, Єю чряшё√трхь ёююЄтхЄёЄтє■∙шщ ёшьтюы т т√їюфэющ сєЇхЁ }
	 stosb
	{ яЁютхЁ хь, эх фюёЄшуэєЄ ыш ЁрчьхЁ фхъюфшЁютрээюую сєЇхЁр,
	хёыш ─└, Єю т√їюфшь шч Ўшъыр }
	 dec Size; jz @ExitWhile
	{ шэрўх єёЄрэртыштрхь Єхъє∙шщ єчхы Ёртэ√ь ъюЁэхтюьє єчыє }
	 mov ax,Root
	 @Cont:
      loop @loop
    jmp @WhileLoop
    @ExitWhile:
    pop ebx; pop esi; pop edi
  end;
end;
{$EndIf NDef Delphi}

procedure CalcAccS(b:tByte; const Nodes:tNodes; Node:tNodeIndex; var Acc:tDecodeAccelerator);
  var lc:byte;
begin
  lc:=8;
  repeat
    Node:=Nodes[Node].UpperNodes.Refs[(b and 1)];
    b:=b shr 1;
    Dec(lc);
  until (lc=0) or (Node<cBaseNodeCount);
  Acc.Node:=Node;
  Acc.Length:=8-lc;
end;

{$IfNDef Delphi}
procedure CalcAccA(b:tByte; const Nodes:tNodes; Node:tNodeIndex; var Acc:tDecodeAccelerator);
  var lc:byte;
begin
  asm
    mov cx,8
    mov bx,Node
    or bh,bh; jz @Skip
    les si,Nodes
    mov al,b
    @Loop:
      shr al,1; rcl bx,2
      mov bx,es:[si][bx]
      or bh,bh
    loopnz @Loop
    @Skip:
    sub cl,8; neg cl
    les si,Acc
    mov tDecodeAccelerator(es:[si]).Node,bx
    mov tDecodeAccelerator(es:[si]).Length,cl
  end;
end;
{$Else IfNDef Delphi}
procedure CalcAccA(b:tByte; {EAX}
	     const Nodes:tNodes; {EDX}
		   Node:tNodeIndex; {ECX}
	       var Acc:tDecodeAccelerator {on stack});
register; assembler;
  asm
    push ebx
    movzx ebx,Node
    mov ecx,8
    or bh,bh; jz @Skip
    @Loop:
      shr al,1; rcl ebx,2
      mov bx,[Nodes][ebx]
      or bh,bh
    loopnz @Loop
    @Skip:
    sub cl,8; neg cl
    mov eax,Acc
    mov tDecodeAccelerator([eax]).Node,bx
    mov tDecodeAccelerator([eax]).Length,cl
    pop ebx
  end;
{$EndIf NDef Delphi}

procedure CreateAcceleratorsS(
	    var   Accs:tDecodeAccelerators;
	    const Nodes:tNodes;
		  Root:tNodeIndex
);
  var  b:byte;
begin
  { Генерируем таблицу-ускоритель: }
  for b:=Low(b) to High(b) do begin
    CalcAccA(b, Nodes, Root, Accs[b]);
  end;
end;

procedure CreateAccelerators(
	    var   Accs:tDecodeAccelerators;
	    const Nodes:tNodes;
		  Root:tNodeIndex
);
  var  b,n:byte;
       PAcc:^tDecodeAccelerator;
       l:1..7;
  const
  cAcc0:tDecodeAccelerator=(Node:-1; Length:0);
begin
  { Заполняем всю таблицу пустыми значениями; }
  FillMemByPattern(Accs, SizeOf(Accs), cAcc0, SizeOf(cAcc0));
  { Генерируем таблицу-ускоритель декодировки (ТУД): }
  for b:=Low(b) to High(b) do begin
    { ссылка на очередной элемент ТУД (для удобства) }
    PAcc:=@Accs[b];
    { если очередной элемент ТУД пустой, }
    if PAcc^.Length=0 then begin
      { то создаем его }
      CalcAccA(b, Nodes, Root, PAcc^);
      { если элемент ТУД содержит менее 8 бит, }
      if PAcc^.Length<8 then begin
	{ то заполняем оставшиеся биты всеми возможными значениями }
	l:=PAcc^.Length;
	for n:=0 to (High(byte) shr l) do begin
	  { код длиной менее 8 бит порождает более 1-го элемента ТУД }
	  Accs[b or (n shl l)]:=PAcc^;
	end;
      end;
    end;
  end;
end;

{ Декодирует буфер InBuf в OutBuf. Size - размер исходного (несжатого) буфера.
Размер, зарезервированный под OutBuf, должен быть не меньше Size }
procedure DecodeAdvanced(
	    const InBuf;
	    var   OutBuf;
		  Size:tBufferIndex;
	    const Nodes:tNodes;
		  Root:tNodeIndex
);
{  УСКОРЕННАЯ ТАБЛИЧНАЯ ДЕКОДИРОВКА - это обгоняет ассемблерный вариант
простой декодировки.

  Идея алгоритма состоит в том, что большая часть кодов Хаффмана короткие
коды (<8 бит), иначе нам не получить сокращение размера данных при упаковке,
и только редкие коды длиннее 8 бит. Поэтому, значительно ускорив декодировку
коротких кодов, мы можем существенно ускорить декодировку в целом.
  Ускорить декодировку коротких кодов можно с помощью предварительного
создания декодировочной таблицы для 8 бит кода (байта). В этом случае мы будем
декодировать короткие коды (и начало длинных кодов) за одно обращение к
таблице, а остаток кода можно декодировать проходом по дереву.
}
  type
    tWord=record
       case byte of
       0:(Word:word);
       1:(LoByte,HiByte:byte);
    end;
  var
    j,i:tBufferIndex;
    w:tWord;
    l:0..8;
    lc:byte;
    Node:tNodeReference;
    Accs:tDecodeAccelerators;
{    ByteDecoded:boolean;}
begin
  if Size=0 then Exit;
  { Вычисляем таблицу-ускоритель декодировки }
  CreateAccelerators(Accs, Nodes, Root);

  { Задаем начальные значения переменных }
  i:=0; {-индекс для кодированного буфера }
  w.Word:=0; {-вспомогательная переменная для хранения декодируемых битов и операций над ними }
  lc:=0; {-длина битовой последовательности во вспомогательной переменной w.Word}

  { Цикл декодирования буфера. }
  for j:=0 to Size do begin { Декодирование байта данных. }
    { Проверяем текущую длину данных lc во вспомогательной переменной w, }
    if lc<8 then begin
      { если там меньше 8 бит, то считываем очередной байт данных из
      кодированного (входного) буфера, чтобы получить полный байт (8 бит)
      для декодировки по таблице. }
      w.Word:=w.Word or (tBuffer(InBuf)[i] shl lc);
      Inc(i); Inc(lc,8);
    end;

    { Декодируем первые 8 бит табличной декодировкой. }
    Node:=Accs[w.LoByte].Node;
    { Изменяем данные по числу оставшихся недекодированными битов. }
    l:=Accs[w.LoByte].Length;

     Dec(lc,l); w.Word:=w.Word shr l;

    {$IfOpt R+}
      {доп. проверка на ошибку диапазона }
      if (Node<0) or (Node>=Root) then
	RunError(201);
    {$EndIf}

    { Если Node не узел базовой таблицы, }
    while (Node>=cBaseNodeCount) do begin
      if lc=0 then begin
        {$IfOpt R+}
        if i>=Size then
          RunError(201);
        {$EndIf}
       { Считываем очередной байт данных из кодированного
       (входного) буфера во вспомогательную переменную w. }
        w.LoByte:=tBuffer(InBuf)[i];
        Inc(i); lc:=8;
      end;

    { Декодировка проходом по дереву. }
      Node:=Nodes[Node].UpperNodes.Refs[(w.LoByte and 1)];
      w.Word:=w.Word shr 1;
      Dec(lc);
    end;
(*
    if (Node>=cBaseNodeCount) then begin
      { то декодируем остаток проходом по дереву. }
      repeat
	if lc=0 then begin
	  { Считываем очередной байт данных из кодированного
	  (входного) буфера во вспомогательную переменную w. }
	  w.LoByte:=tBuffer(InBuf)[i];
	  Inc(i); lc:=8;
	end;

       { Декодировка проходом по дереву. }
	repeat
	  Node:=Nodes[Node].UpperNodes.Refs[(w.LoByte and 1)];
	  w.Word:=w.Word shr 1;
	  Dec(lc);
	  ByteDecoded:=(Node<cBaseNodeCount);
	until ByteDecoded or (lc=0);

      until ByteDecoded;
    end;
*)
    { Заносим Node в декодированный буфер. }
    tBuffer(OutBuf)[j]:=Node;
  end;
end;

{ Декодирует буфер InBuf в OutBuf. Size - размер исходного (несжатого) буфера.
Размер, зарезервированный под OutBuf, должен быть не меньше Size }
procedure DecodeAdvancedASM(
	    const InBuf;
	    var   OutBuf;
		  Size:tBufferIndex;
	    const Nodes:tNodes;
		  Root:tNodeIndex);
{ вручную оптимизированная табличная декодировка }
{$IfNDef Delphi}
  var
    Accs:tDecodeAccelerators;
    OfsAccs:word;
begin
  if Size=0 then Exit;
  { Вычисляем таблицу-ускоритель декодировки }
  CreateAccelerators(Accs, Nodes, Root);
  OfsAccs:=Ofs(Accs);
  asm
    push ds
    les di,OutBuf
    lds si,InBuf
    cld
    xor ax,ax; cwd; mov cx,ax

    @loop:
      cmp cl,8; jae @DoNotLoad
	{ загрузка данных из кодированного буфера }
	lodsb
	shl ax,cl
	or dx,ax
	add cl,8
      @DoNotLoad:

      { BX:=SizeOf(tDecodeAccelerator)*DL = 4*DL }
      xor bh,bh; mov bl,dl; shl bx,2

      add bx,OfsAccs { BX:=Ofs(Accs[DL]) }

      mov ax,ss:tDecodeAccelerator([bx]).Node { AX:=Accs[DL].Node }
      { изменение длины недекодированной последовательности бит в CL
      и самой последовательности бит в DL}
      mov ch,cl { CH:=CL }
      mov cl,ss:tDecodeAccelerator([bx]).Length { CL:=Accs[DL].Length }
      shr dx,cl; { DX:=DX shl (число декодированных бит) }
      sub cl,ch; neg cl { CL:=(число оставшихся бит) }

      or ah,ah; jz @Decoded
	{ не декодировано до конца - продолжить проход по дереву }
	mov bx,ax
	mov ax,si
	xor ch,ch
	jcxz @EnterLoopTD;
	jmp @DoNotLoad1
	{ цикл декодировки проходом по дереву }
	@LoopTD:
	  { загрузка данных из кодированного буфера }
	    mov ds,tPointer(InBuf).&Seg
	    @EnterLoopTD:
	      mov si,ax
	      mov dl,[si]
	      inc ax
	      mov cl,8
	  @DoNotLoad1:

	  { декодировка загруженных данных проходом по дереву }
	  lds si,Nodes
	  @LoopTD1:
	    shr dx,1; rcl bx,2
	    mov bx,[si][bx]
	    or bh,bh
	  loopnz @LoopTD1

	jnz @LoopTD
	{ конец цикл декодировки проходом по дереву }
	mov ds,tPointer(InBuf).&Seg
	mov si,ax
	mov ax,bx
      @Decoded:
      stosb { запоминание декодированного символа в OutBuf }
      dec Size { уменьшение числа недекодированных символов }
    jnz @loop
    pop ds
  end;
end;
{$Else IfNDef Delphi}
  var
    Accs:tDecodeAccelerators;
    OfsAccs:pointer;
begin
  if Size=0 then Exit;
  { ┬√ўшёы хь ЄрсышЎє-єёъюЁшЄхы№ фхъюфшЁютъш }
  CreateAccelerators(Accs, Nodes, Root);
  OfsAccs:=@Accs[0];
  asm
    push ebx; push edi; push esi
    mov edi,OutBuf
    mov esi,InBuf
    mov ebx,OfsAccs
    xor ecx,ecx; xor edx,edx; xor eax,eax

    @loop:
      cmp cl,8; jae @NotLoad
	lodsb
	shl ax,cl; or dx,ax; add cl,8
      @NotLoad:

      movzx eax,dl; shl ax,2
      add eax,ebx

      mov ch,cl
      mov cl,tDecodeAccelerator([eax]).Length
      shr dx,cl; sub cl,ch; neg cl
      mov ax,tDecodeAccelerator([eax]).Node

      or ah,ah; jz @Decoded
	xor ch,ch
	xchg ax,dx
	mov ebx,Nodes
	@LoopTD:
	  or cl,cl; jnz @NotLoad1
	    mov cl,16
	    cmp Size,ecx; jae @LodsW
	      lodsb
	      mov cl,8
	    jmp @LodsB
	    @LodsW:
	      lodsw
	    @LodsB:
	  @NotLoad1:

	  @LoopTD1:
	    shr ax,1; rcl dx,2
	    mov dx,[ebx][edx]
	    or dh,dh
	  loopnz @LoopTD1

	jnz @LoopTD
	xchg ax,dx
	mov ebx,OfsAccs
      @Decoded:
      stosb
      dec Size
    jnz @loop
    pop esi; pop edi; pop ebx
  end;
end;
{$EndIf NDef Delphi}

procedure ProcTypeSetAll(pt:tProcType);
  var p:tProcedure;
begin
  for p:=Succ(Low(p)) to High(p) do begin
    ProcTypeSet(p, pt);
  end;
end;

procedure ProcTypeSet(p:tProcedure; pt:tProcType);
begin
  if p=pAll then begin
     ProcTypeSetAll(pt);
  end else
  case pt of

    ptSimple:begin
      case p of
	pCountBytes:begin
	  CountBytes:=CountBytesSimple;
	end;
	pDefineCodes:begin
	  DefineCodes:=DefineCodesSimple;
	end;
	pBuildTree:begin
	  BuildTree:=BuildTreeSimple;
	end;
	pEncode:begin
	  Encode:=EncodeSimple;
	end;
	pDecode:begin
	  Decode:=DecodeSimple;
	end;
	else begin
	end;
      end;
    end;

    ptSimpleAsm:begin
      case p of
	pCountBytes:begin
	  CountBytes:=CountBytesSimpleAsm;
	end;
	pDefineCodes:begin
	  DefineCodes:=DefineCodesSimple;
	end;
	pBuildTree:begin
	  BuildTree:=BuildTreeSimpleAsm;
	end;
	pEncode:begin
	  Encode:=EncodeSimpleAsm;
	end;
	pDecode:begin
	  Decode:=DecodeSimpleAsm;
	end;
	else begin
	end;
      end;
    end;

    ptAdvanced:begin
      case p of
	pCountBytes:begin
	  CountBytes:=CountBytesSimple;
	end;
	pDefineCodes:begin
	  DefineCodes:=DefineCodesSimple;
	end;
	pBuildTree:begin
	  BuildTree:=BuildTreeAdvanced;
	end;
	pEncode:begin
	  Encode:=EncodeSimple;
	end;
	pDecode:begin
	  Decode:=DecodeAdvanced;
	end;
	else begin
	end;
      end;
    end;

    ptAdvancedAsm:begin
      case p of
	pCountBytes:begin
	  CountBytes:=CountBytesSimpleAsm;
	end;
	pDefineCodes:begin
	  DefineCodes:=DefineCodesSimple;
	end;
	pBuildTree:begin
	  BuildTree:=BuildTreeAdvanced;
	end;
	pEncode:begin
	  Encode:=EncodeSimpleAsm;
	end;
	pDecode:begin
	  Decode:=DecodeAdvancedAsm;
	end;
	else begin
	end;
      end;
    end;

    else begin
    end;
  end;
end;


function  ProcTypeGet(p:tProcedure):tProcType;
begin
  ProcTypeGet:=ptSimple;
  case p of
    pCountBytes:begin
      if @CountBytes=@CountBytesSimpleAsm then begin
	ProcTypeGet:=ptSimpleAsm;
      end;
    end;
    pDefineCodes:begin
    end;
    pBuildTree:begin
      if @BuildTree=@BuildTreeSimpleAsm then begin
	ProcTypeGet:=ptSimpleAsm;
      end;
    end;
    pEncode:begin
      if @Encode=@EncodeSimpleAsm then begin
	ProcTypeGet:=ptSimpleAsm;
      end;
    end;
    pDecode:begin
      if @Decode=@DecodeSimpleAsm then begin
	ProcTypeGet:=ptSimpleAsm;
      end else if @Decode=@DecodeAdvanced then begin
	ProcTypeGet:=ptAdvanced;
      end else if @Decode=@DecodeAdvancedAsm then begin
	ProcTypeGet:=ptAdvancedASM;
      end;
    end;
  end;
end;

procedure ProcTypeSetDefault;
  var p:tProcedure;
begin
  for p:=Low(p) to High(p) do begin
    ProcTypeSet(p, High(tProcType));
  end;
end;

BEGIN
  ProcTypeSetDefault;

  { Проверка размеров и выравнивания для структур -
  это нужно для правильной работы асссемблерных вариантов процедур }
{$IfDef Delphi}
  if (SizeOf(tNodesData)<>8*Succ(High(tNodeIndex))) then
    RunError(201);
{$Else IfDef Delphi}
  if (SizeOf(tNodesData)<>4*Succ(High(tNodeIndex))) then
    RunError(201);
{$EndIf Def Delphi}
  if ( SizeOf(tCodes)<>(33*Succ(High(tBaseNodeIndex))) ) then
    RunError(201);
  if (SizeOf(tDecodeAccelerators)<>4*Succ(High(tBaseNodeIndex))) then
    RunError(201);
  if ( SizeOf(tNodes)<>(4*Succ(High(tNodeIndex))) )
    or ( SizeOf(tUpNodesReference)<>(2*SizeOf(tNodeReference)) ) then
    RunError(201);

{  Assign(f, 'treelog.txt');
  Rewrite(f);
  Assign(fok, 'treelog.ok');
  Reset(fok);}
END.