{DOS-text
Реализация битового буфера для для сжатия

 Последовательная
   1) Запись (Put) произвольного числа бит (не более 16 для BP 7.0
						 или 32 для Delphi)
      в буфер.
   2) Чтение (Get) произвольного числа бит (не более 16 для BP 7.0
						 или 32 для Delphi)
      из буфера.

Главная функция этого модуля - плотная запись и непрерывное считывание
порций данных (кодов) не кратных 8 битам (байту) из последовательности
бит.
  Основные процедуры модуля написаны на ассемблере, поскольку операции
с битами на Паскале недостаточно эффективны.

}
{WIN-text
╨хрышчрЎш  сшЄютюую сєЇхЁр фы  фы  ёцрЄш  

 ╧юёыхфютрЄхы№эр 
   1) ╟ряшё№ (Put) яЁюшчтюы№эюую ўшёыр сшЄ (эх сюыхх 16 фы  BP 7.0
						 шыш 32 фы  Delphi)
      т сєЇхЁ.

   2) ╫Єхэшх (Get) яЁюшчтюы№эюую ўшёыр сшЄ (эх сюыхх 16 фы  BP 7.0
						 шыш 32 фы  Delphi)
      шч сєЇхЁр.

├ыртэр  ЇєэъЎш  ¤Єюую ьюфєы  - яыюЄэр  чряшё№ ш эхяЁхЁ√тэюх ёўшЄ√трэшх
яюЁЎшщ фрээ√ї (ъюфют) эх ъЁрЄэ√ї 8 сшЄрь (срщЄє) шч яюёыхфютрЄхы№эюёЄш
сшЄ.
  ╬ёэютэ√х яЁюЎхфєЁ√ ьюфєы  эряшёрэ√ эр рёёхьсыхЁх, яюёъюы№ъє юяхЁрЎшш
ё сшЄрьш эр ╧рёърых эхфюёЄрЄюўэю ¤ЇЇхъЄштэ√.

}
{---------------------------------------------------------------------------
(c) Copyright	 Aleksandrov O.E., 2005

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 375-41-46
   E-mail: aleks@dpt.ustu.ru

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

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 375-41-46
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}
{откл. $Define DebugBuf - включает отладку буфера, при этом ведется запись
			  в файлы 'IndexesA.txt' и 'IndexesG.txt'
			  информации по записи и чтению из буфера.}
{юЄъы. $Define DebugBuf - тъы■ўрхЄ юЄырфъє сєЇхЁр, яЁш ¤Єюь тхфхЄё  чряшё№
			  т Їрщы√ 'IndexesA.txt' ш 'IndexesG.txt'
			  шэЇюЁьрЎшш яю чряшёш ш ўЄхэш■ шч сєЇхЁр.}
Unit BitBuf;
{$IfDef NoChecking}
  {$R-,S-,Q-}
{$EndIf}

INTERFACE

type
  tFlag=(fRead, fWrite);
  tFlags=set of tFlag;

  tData={$IfDef Delphi} cardinal {$else}word{$endif};
  tPData=^tData;
  tDataBitsCounter=0..SizeOf(tData)*8;
  tBufferIndex=0..{$IfDef Delphi} 1023*1024*1024 {$else}High(word)-8{$endif};
  tBuffer=packed array[tBufferIndex] of byte;
  tPBuffer=^tBuffer;

  { буфер переноса } { сєЇхЁ яхЁхэюёр }
  tIntermediateBuffer=record
    case byte of
     0:(Arr:packed array[0..1] of tData);
     1:(I0,I1:tData);
     2:(ByteArr:packed array[0..2*SizeOf(tData)-1] of Byte);
  end;

  tBitBuffer=object
    {$IfNDef Debug}
    private
    {$EndIf}
      prFlags:tFlags;  { внутренние флаги }
      prPBuffer:tPBuffer; { указатель на первый байт (начало) в основном буфере }
      prBuffSize:tBufferIndex; { размер (байт) основного буфера }
      prFreeSize:tBufferIndex; { число свободных байт в основном буфере}
      prBufferFreePtr:tPBuffer;   { указатель на первый свободный байт в основном буфере }
      prImdBuf:tIntermediateBuffer; { буфер переноса }
      prImdBufBitsCount:byte;       { количество бит в буфере переноса }

      { очищает буфер переноса и устанавливает указатели на начало буфера }
      procedure   ResetX;

      { устанавливает указатели на начало буфера -
      после чего буфер считается пустым, но сохраняет буфер переноса }
      procedure   Clear;

    public
    { ---- Процедуры инициализации }
      constructor Init;
      destructor  Done;

      { устанавливает указатели в NIL и очищает буфер переноса -
      после чего буфер считается неинициализированным }
      procedure   Reset;

    { ---- Процедуры записи в буфер }
      { Назначает основной буфер для записи (сохраняет буфер переноса) }
      procedure   AssignForWrite(var ABuffer; ASize:tBufferIndex);

      { Переключает буфер в режим записи (сохраняет буфер переноса) }
      procedure   ResetWrite;

      { Записывает в буфер ABitsCount бит из AIndex.
      !!! в основной буфер переносятся только целые байты,
      остаток бит (менее 8) сохраняется в буфере переноса.
      Возвращает TRUE, если ВСЕ биты записаны, иначе
		 FALSE - кончилось свободное место, AIndex
		 в этом случае не записан в буфер. }
      function Put(AIndex:tData; ABitsCount:tDataBitsCounter):boolean; {$IfDef Delphi} register; {$EndIf}
      function xPut(AIndex:tData; ABitsCount:tDataBitsCounter):boolean; {$IfDef Delphi} register; {$EndIf}
(*      function PutNew(AIndex:tIndex; ABitsCount:tIndexBitsCounter):boolean; {$IfDef Delphi} register; {$EndIf}*)
      { Записывает в буфер остаток бит из буфера переноса,
      дополнив их 0-ми битами до полного байта. Возвращает TRUE, если
      биты пренесены (в том числе и если переносить нечего),
      иначе FALSE - нет места. }
      function PutFlush:boolean;

      { Возвращает TRUE, если в буфере нет больше свободного места. }
      function Full:boolean;

    { ---- Процедуры чтения из буфера }
      { Назначает основной буфер для чтения (сохраняет буфер переноса) }
      procedure AssignForRead(const ABuffer; ASize:tBufferIndex);

      { Переключает буфер в режим чтения (сохраняет буфер переноса) }
      procedure ResetRead;

      { Читает из буфера ABitsCount бит в AIndex.
      !!! из основного буфера всегда считываются только целые байты,
      остаток бит сохраняется в буфере переноса.
      Возвращает TRUE, если биты прочитаны, иначе FALSE - кончились данные
      в буфере. }
      function Get(var AIndex:tData; ABitsCount:tDataBitsCounter):boolean; {$IfDef Delphi} register; {$EndIf}

      { Удаляет остаток бит из буфера переноса. Возвращает TRUE, если были
      биты в буфере переноса. }
      function GetFlush:boolean;

      { Возвращает TRUE, если в буфере нет больше данных размера ABitCount. }
      function Empty(ABitCount:tDataBitsCounter):boolean;

    { ---- Процедуры информационные }
      { Возвращает размер буфера в байтах }
      function FullSize:tBufferIndex;
      { Возвращает размер данных в буфере (записанных/прочитанных) в байтах }
      function Size:tBufferIndex;
      { Возвращает размер данных в буфере переноса в битах }
      function BitsCount:tDataBitsCounter;

  end;

IMPLEMENTATION
  {$IfDef Delphi} USES LZMiscFs;{$EndIf}

function tBitBuffer.FullSize:tBufferIndex;
begin
  FullSize:=prBuffSize;
end;

function tBitBuffer.Size:tBufferIndex;
begin
  Size:=prBuffSize-prFreeSize;
end;

function tBitBuffer.BitsCount:tDataBitsCounter;
begin
  BitsCount:=prImdBufBitsCount;
end;

function tBitBuffer.Full:boolean;
begin
  Full:=(prFreeSize=0);
end;

function tBitBuffer.Empty(ABitCount:tDataBitsCounter):boolean;
begin
  Empty:=(prFreeSize=0) and (prImdBufBitsCount<ABitCount);
end;

constructor tBitBuffer.Init;
begin
  Reset;
end;

destructor tBitBuffer.Done;
begin
  Reset;
end;

{ ╧юыэюх єфрыхэшх сєЇхЁр ш яЁштхфхэшх ярЁрьхЄЁют ъ ёюёЄю эш■ яю-єьюыўрэш■}
procedure tBitBuffer.Reset;
begin
  prFlags:=[];    {╤сЁюё Їыруют юяхЁрЎшш (Read | Write)}
  prPBuffer:=NIL; { ╤сЁюё єърчрЄхы  эр фрээ√х сєЇхЁр }
  prBuffSize:=0;  { ╙ёЄрэютър ЁрчьхЁют сєЇхЁр = 0 }
  ResetX; { ╫рёЄшўэ√щ ёсЁюё - яюьхўрхь сєЇхЁ ъръ яюыэюёЄ№■ яєёЄющ}
end;

{ ╫рёЄшўэ√щ ёсЁюё - яюьхўрхь сєЇхЁ ъръ яюыэюёЄ№■ яєёЄющ}
procedure tBitBuffer.ResetX;
begin
  prImdBuf.I0:=0; {╬ўш∙рхь сєЇхЁ яхЁхэюёр}
  prImdBufBitsCount:=0; {╧юьхўрхь сєЇхЁ яхЁхэюёр ъръ яєёЄющ}
  Clear; {╧юьхўрхь сєЇхЁ ъръ ётюсюфэ√щ}
end;

{╧юьхўрхЄ сєЇхЁ ъръ ётюсюфэ√щ}
procedure tBitBuffer.Clear;
begin
  prFreeSize:=prBuffSize;
  prBufferFreePtr:=prPBuffer;
end;

{$IfDef DebugBuf }
var fa:Text; na:{$IfDef Delphi} cardinal {$Else}word{$EndIf}; ta:{$IfDef Delphi} cardinal {$Else}longint {$EndIf};
procedure WriteIndexA(AIndex:tData; Count:tDataBitsCounter);{$IfDef Delphi} register; {$EndIf}
begin
  Inc(na);
  Inc(ta);
  writeln(fa, ta:10, ': ', {na:5,'. ',} AIndex:10, ':', Count);
  if ta=1748651 then
    writeln;
end;
{$EndIf Def DebugBuf }

{ ╚эшЎшрышчшЁєхЄ сєЇхЁ ёё√ыъющ эр юсырёЄ№ фрээ√ї ABuffer ЁрчьхЁюь ASize срщЄ ъръ яЁхфэрчэрўхээ√щ фы  чряшёш}
procedure tBitBuffer.AssignForWrite(var ABuffer; ASize:tBufferIndex);
begin
{$IfDef DebugBuf }
  na:=0;
{$EndIf Def DebugBuf }
  ResetWrite;
  prPBuffer:=@tBuffer(ABuffer);
  prBuffSize:=ASize;
  Clear;
end;

{ ╧юьхўрхЄ сєЇхЁ ъръ яЁхфэрчэрўхээ√щ фы  чряшёш }
procedure tBitBuffer.ResetWrite;
begin
  if not (fWrite in prFlags) then begin
    ResetX;
    Include(prFlags,fWrite);
  end;
end;

{ $IfNDef Delphi}
procedure RunError201;
begin
  RunError(201);
end;
{ $EndIf NDef Delphi}

procedure CheckWrite(Flags:tFlags); {$IfDef Delphi} register; {$EndIf}
begin
  if not (fWrite in Flags) then
    RunError(201);
end;

{ ╟ряшё√трхЄ ABitsCount сшЄ шч AIndex т сєЇхЁ. ┬ючтЁр∙рхЄ TRUE, хёыш єёях°эю, шэрўх т сєЇхЁх чръюэўшыюё№ ётюсюфэюх ьхёЄю }
function tBitBuffer.xPut(AIndex:tData; ABitsCount:tDataBitsCounter):boolean;
  var FullBitsCount:word; FullBytesCount:byte; i,j:byte;
begin
  if prFreeSize=0 then begin xPut:=FALSE; exit; end;
  FullBitsCount:=word(ABitsCount)+prImdBufBitsCount;
  if FullBitsCount<8 then begin
    prImdBuf.I0:=prImdBuf.I0 or (AIndex shl prImdBufBitsCount);
    prImdBufBitsCount:=FullBitsCount;
  end else if prFreeSize>=SizeOf(AIndex) then begin
    tPData(prBufferFreePtr)^:=prImdBuf.I0 or (AIndex shl prImdBufBitsCount);
    prImdBufBitsCount:=FullBitsCount and 7;
    prImdBuf.I0:=AIndex shr (ABitsCount-prImdBufBitsCount);
    FullBytesCount:=(FullBitsCount shr 3);
    Dec(prFreeSize,FullBytesCount);
    prBufferFreePtr:=@prBufferFreePtr^[FullBytesCount];
  end else begin
    prImdBuf.I0:=prImdBuf.I0 or (AIndex shl prImdBufBitsCount);
    prImdBuf.I1:=(AIndex shr (8*SizeOf(AIndex) - prImdBufBitsCount));
    FullBytesCount:=(FullBitsCount shr 3);
    i:=0;
    repeat
      prBufferFreePtr^[i]:=prImdBuf.ByteArr[i];
      Inc(i);
      Dec(prFreeSize);
      Dec(FullBytesCount);
    until (prFreeSize=0) or (FullBytesCount=0);
    prBufferFreePtr:=@prBufferFreePtr^[i];
    prImdBufBitsCount:=(FullBitsCount and 7)+ (FullBytesCount*8);
    for j:=0 to FullBytesCount do begin
      prImdBuf.ByteArr[j]:=prImdBuf.ByteArr[i];
      Inc(i);
    end;
  end;
  xPut:=TRUE;
end;

{ ╟ряшё√трхЄ ABitsCount сшЄ шч AIndex т сєЇхЁ. ┬ючтЁр∙рхЄ TRUE, хёыш єёях°эю, шэрўх т сєЇхЁх чръюэўшыюё№ ётюсюфэюх ьхёЄю }
function tBitBuffer.Put(AIndex:tData; ABitsCount:tDataBitsCounter):boolean;
{$IfNDef Delphi}
assembler;
asm
{$IfDef DebugBuf }
  push AIndex
  mov al,ABitsCount; xor ah,ah
  push ax
  call WriteIndexA;
{$EndIf Def DebugBuf }
  {$IfOpt R+}
    les si,Self; mov al,es:tBitBuffer([si]).prFlags; xor ah,ah; push ax; call CheckWrite
  {$EndIf}
  push ds
  lds si,Self
  { проверяем наличие свободного места в буфере }
(*  mov di,tBitBuffer([si]).prFreeSize; { DI:= prFreeSize}
  or di,di; jz @ExitFALSE*)
  mov cx,tBitBuffer([si]).prFreeSize; { CX:= prFreeSize}
  jcxz @ExitFALSE
    mov di,cx { DI:= prFreeSize}
  { место есть - копируем биты }
    { CL:=число бит в промежуточном буфере }
    mov cl,tBitBuffer([si]).prImdBufBitsCount;
    { AX:= биты промежуточного буфера }
    mov ax,word(tBitBuffer([si]).prImdBuf)
    { DX:= AIndex; BX:=AIndex }
    mov dx,AIndex; mov bx,dx
    { дополняем AX битами из BX: AX:=AX or (BX shl CL)}
    shl bx,cl; or ax,bx

    { CH:=полное число бит в AX:DX }
    mov bl,cl; add bl,ABitsCount; mov ch,bl
    { BX:=CH div 8 (=число полных байт) }
    shr bl,3; xor bh,bh
    cmp bl,1; jb @Less1 { менее 8 бит данных в основной буфер не заносятся }
    je @EnoughSize   { 1 байт в буфере свободен в любом случае }

      {$IfOpt R+}
	{ число байтов не может быть больше 3-х }
	cmp bl,4; jb @OK;
	  call RunError201;
	@OK:
      {$EndIf}

    { сравниваем BX и свободный размер в буфере }
    cmp bx,di; jbe @EnoughSize { буфер НЕзакончился }
      { в буфере НЕдостаточно свободного места }
      mov bx,di

    @EnoughSize: { в буфере достаточно свободного места }

       { ES:[DI]-> свободное место в буфере }
       les di,tBitBuffer([si]).prBufferFreePtr
       { уменьшение свободного размера основного буфера }
       sub tBitBuffer([si]).prFreeSize,bx

      cmp bl,2; je @2; ja @3
      @1: { 1 байт - записываем в буфер }
	stosb; sub ch,8
	{ AX:=остаток }
	shr ax,8
      jmp @StoreRest

      @2: { 2 байта - записываем в буфер }
	stosw; sub ch,16
	{ удаляем из DX перенесенные (16-CL) бит, теперь DX содержит биты остатка }
	sub cl,16; neg cl; shr dx,cl
	{ AX:=остаток }
	mov ax,dx
      jmp @StoreRest

      @3: { 3 байта - записываем в буфер }
	{ удаляем из DX перенесенные (16-CL) бит, теперь DX содержит биты остатка }
	sub cl,16; neg cl; shr dx,cl
	stosw; mov al,dl; stosb; sub ch,16+8
	{ AX:=остаток }
	mov ax,dx; shr ax,8
      @StoreRest:

      { запоминаем указатель на свободное место в основном буфере }
      mov word(tBitBuffer([si]).prBufferFreePtr),di

      @Less1: { менее 8 бит данных в основной буфер не заносятся }
      { запоминаем остаток кода в промежуточном буфере
      !!! в промежуточном буфере не может быть более 2-х байт }
      mov word(tBitBuffer([si]).prImdBuf),ax

    { запоминаем число бит в промежуточном буфере }
    mov tBitBuffer([si]).prImdBufBitsCount,ch;

  @ExitTRUE: mov ax,TRUE;
jmp @Exit
  @ExitFALSE: xor ax,ax;
  @Exit:
  pop ds
end;
{$Else IfNDef Delphi}
register;
{ EAX:= Self;
  EDX:= AIndex
  CL:= ABitsCount}
asm
{$IfDef DebugBuf }
  push eax; push edx; push ecx;
  mov eax, AIndex
  movzx edx,ABitsCount
  call WriteIndexA;
  pop ecx; pop edx; pop eax;
{$EndIf Def DebugBuf }
  push esi; push edi; push ebx
  mov esi,Self
  {$IfOpt R+}
    push AIndex
    mov  al,ABitsCount
    push ax
    movzx eax,tBitBuffer([esi]).prFlags
    call CheckWrite
    pop ax; mov ABitsCount,al; pop AIndex;
  {$EndIf}
  mov edi,tBitBuffer([esi]).prFreeSize
  or edi,edi; jz @ExitFALSE
    { CH:=ўшёыю сшЄ т AIndex }
    mov ch,ABitsCount;
    { CL:=ўшёыю сшЄ т яЁюьхцєЄюўэюь сєЇхЁх }
    mov cl,tBitBuffer([esi]).prImdBufBitsCount;
    { EAX:= сшЄ√ яЁюьхцєЄюўэюую сєЇхЁр }
    mov eax,dword(tBitBuffer([esi]).prImdBuf)
    { EDX:= AIndex; EBX:=AIndex }
    {mov edx,AIndex; єцх яЁшётюхэю } mov ebx,edx
    { фюяюыэ хь EAX сшЄрьш шч EBX: EAX:=EAX or (EBX shl CL)}
    shl ebx,cl;  or eax,ebx

    movzx ebx,cl
   { єфры хь шч EDX яхЁхэхёхээ√х (32-CL) сшЄ, ЄхяхЁ№ EAX:EDX ёюфхЁцрЄ тёх сшЄ√ }
    mov cl,32; sub cl,bl; shr edx,cl;
   { BL:=яюыэюх ўшёыю сшЄ т EAX:EDX }
    add bl,ch
   { CL:=яюыэюх ўшёыю сшЄ т EAX:EDX }
    mov cl,bl

   { EBX:=CL div 8 (=ўшёыю яюыэ√ї срщЄ) }
    shr bl,3
    or bl,bl; jz @Less1 { ьхэхх 8 сшЄ фрээ√ї т юёэютэющ сєЇхЁ эх чрэюё Єё  }

    { ёЁртэштрхь EBX ш ётюсюфэ√щ ЁрчьхЁ т сєЇхЁх (EDI) }
    cmp edi,ebx;  { т сєЇхЁх фюёЄрЄюўэю ётюсюфэюую ьхёЄр }
    db $0F,$42, $DF {cmovb ebx,edi}
(*    cmp ebx,edi; jbe @EnoughSize { т сєЇхЁх фюёЄрЄюўэю ётюсюфэюую ьхёЄр }
      { т сєЇхЁх ═┼фюёЄрЄюўэю ётюсюфэюую ьхёЄр }
      mov ebx,edi
    @EnoughSize:*)
      { [EDI]-> ётюсюфэюх ьхёЄю т сєЇхЁх }
      mov edi,tBitBuffer([esi]).prBufferFreePtr
      { єьхэ№°хэшх ётюсюфэюую ЁрчьхЁр юёэютэюую сєЇхЁр }
      sub tBitBuffer([esi]).prFreeSize,ebx
      {$IfOpt R+}
	{ ўшёыю срщЄют эх ьюцхЄ с√Є№ сюы№°х 7-ш }
	cmp ebx,8; jb @OK;
         call RunError201;
        @OK:
      {$EndIf}

      { Єрсышўэ√щ яхЁхїюф, т чртшёшьюёЄш юЄ ўшёыр срщЄ }
      jmp dword ptr ([(Offset @Jmp)-4][ebx*4])
      @Jmp:  dd (OFFSET @1)
             dd (OFFSET @2)
             dd (OFFSET @3)
             dd (OFFSET @4)
             dd (OFFSET @5)
             dd (OFFSET @6)
             dd (OFFSET @7)

      @1: { 1 срщЄ - чряшё√трхь т сєЇхЁ }
	stosb; sub cl,8
	{ EAX:=юёЄрЄюъ }
	shr eax,8
      jmp @StoreRest

      @2: { 2 срщЄр - чряшё√трхь т сєЇхЁ }
	stosw; sub cl,16
	{ EAX:=юёЄрЄюъ }
	shr eax,8*2
      jmp @StoreRest

      @3: { 3 срщЄр - чряшё√трхь т сєЇхЁ }
	stosw; shr eax,16; stosb; sub cl,3*8
	{ EAX:=юёЄрЄюъ }
	shr eax,8
      jmp @StoreRest

      @4: { 4 срщЄр - чряшё√трхь т сєЇхЁ }
	stosd; sub cl,4*8
	{ EAX:=юёЄрЄюъ }
	mov eax,edx
      jmp @StoreRest

      @5: { 5 срщЄ - чряшё√трхь т сєЇхЁ }
	stosd; mov eax,edx; stosb; sub cl,5*8
	{ EAX:=юёЄрЄюъ }
	shr eax,8
      jmp @StoreRest

      @6: { 6 срщЄ - чряшё√трхь т сєЇхЁ }
	stosd; mov eax,edx; stosw; sub cl,6*8
	{ EAX:=юёЄрЄюъ }
	shr eax,16
      jmp @StoreRest

      @7: { 7 срщЄ - чряшё√трхь т сєЇхЁ }
	stosd; mov eax,edx; stosw; shr eax,16; stosb; sub cl,7*8
	{ EAX:=юёЄрЄюъ }
	shr eax,8

      @StoreRest:
      { чряюьшэрхь єърчрЄхы№ эр ётюсюфэюх ьхёЄю т юёэютэюь сєЇхЁх }
      mov tBitBuffer([esi]).prBufferFreePtr,edi

      @Less1:
      { чряюьшэрхь юёЄрЄюъ ъюфр т яЁюьхцєЄюўэюь сєЇхЁх
      !!! т яЁюьхцєЄюўэюь сєЇхЁх эх ьюцхЄ с√Є№ сюыхх 4-ї срщЄ }
      mov tBitBuffer([esi]).prImdBuf.I0,eax

    { чряюьшэрхь ўшёыю сшЄ т яЁюьхцєЄюўэюь сєЇхЁх }
    mov tBitBuffer([esi]).prImdBufBitsCount,cl;

  @ExitTRUE: mov eax,TRUE; jmp @Exit
  @ExitFALSE: xor eax,eax;
  @Exit:
  pop ebx; pop edi; pop esi
end;
{$EndIf NDef Delphi}

{ принудительная запись остатка бит в буфер
(дополнение до целого байта нулевыми битами)}
function tBitBuffer.PutFlush:boolean;
begin
  {$IfOpt R+}
  if not (fWrite in prFlags) then
    RunError(201);
  {$EndIf}
  if prImdBufBitsCount>0 then begin
    if Put(0,7) then begin
      prImdBufBitsCount:=0; { все перенесено - сброс остатка }
      PutFlush:=TRUE;
    end else begin
      PutFlush:=FALSE;
    end;
  end else begin
    PutFlush:=TRUE;
  end;
end;

{$IfDef DebugBuf }
var fg:Text; ng:{$IfDef Delphi} cardinal {$Else}word{$EndIf}; tg:{$IfDef Delphi} cardinal {$Else}longint {$EndIf};
procedure WriteIndexG(AIndex:tData; Count:tDataBitsCounter); {$IfDef Delphi} register; {$EndIf}
begin
  Inc(ng);
  Inc(tg);
  writeln(fg, tg:10, ': ',{ng:5,'. ',} AIndex:10, ':', Count);
  if Count=1 then
    RunError(201);
  if tg=1748651 then
    writeln;
end;
{$EndIf Def DebugBuf }

{ ╚эшЎшрышчшЁєхЄ сєЇхЁ ёё√ыъющ эр юсырёЄ№ фрээ√ї ABuffer ЁрчьхЁюь ASize срщЄ ъръ яЁхфэрчэрўхээ√щ фы  ўЄхэш }
procedure tBitBuffer.AssignForRead(const ABuffer; ASize:tBufferIndex);
begin
{$IfDef DebugBuf }
  ng:=0;
{$EndIf Def DebugBuf }
  ResetRead;
  prPBuffer:=@tBuffer(ABuffer);
  prBuffSize:=ASize;
  Clear;
end;

{ ╧юьхўрхЄ сєЇхЁ ъръ яЁхфэрчэрўхээ√щ фы  ўЄхэш  }
procedure tBitBuffer.ResetRead;
begin
  if not (fRead in prFlags) then begin
    ResetX;
    Include(prFlags,fRead);
  end;
end;

{ ╤ўшЄ√трхЄ ABitsCount сшЄ т AIndex шч сєЇхЁр. ┬ючтЁр∙рхЄ TRUE, хёыш єёях°эю, шэрўх т сєЇхЁх чръюэўшышё№ фрээ√х }
function tBitBuffer.Get(var AIndex:tData; ABitsCount:tDataBitsCounter):boolean;
{$IfNDef Delphi}
assembler;
asm
  les di,Self
  { CL:=число бит остатка }
  mov cl,es:tBitBuffer([di]).prImdBufBitsCount
  { CH:=запрашиваемое число бит}
  mov ch,ABitsCount
  { загрузка остатка данных из промежуточного буфера в DX:AX }
  mov dx,word(es:tBitBuffer([di]).prImdBuf); {xor ax,ax}
  { CL:=CL-CH = число бит остатка }
  sub cl,ch;
  { проверка числа бит }
  jae @Cont { достаточно бит }
    { недостаточно бит - считывание данных из основного буфера }
    cmp es:tBitBuffer([di]).prFreeSize,1; jb @ExitFALSE { проверка наличия данных в основном буфере }
      push ds
      { DS:[SI]->следующий байт в основном буфере }
      lds si,es:tBitBuffer([di]).prBufferFreePtr
      je @LastByte
      { для того, чтобы не изъять из буфера лишнее }
      cmp cl,(-8) ; jae @OneByte
	add cl,ch;
	{ данных больше чем 1 байт }
	lodsw; mov bx,ax
	{ дополняем DX битами из BX: DX:=DX or (BX shl CL)}
	shl bx,cl; or dx,bx
	{ удаляем из AX перенесенные (16-CL) бит, теперь DX:AX содержат все биты }
	sub cl,16; neg cl; shr ax,cl
	{ CL:=число бит в AX:DX }
	neg cl; add cl,16+16
	{ prFreeSize:=prFreeSize-2}
	sub es:tBitBuffer([di]).prFreeSize,2
      jmp @Check
      @OneByte:
      @LastByte:
	add cl,ch;
	{ последний байт данных }
	lodsb; xor ah,ah; mov bx,ax
	{ дополняем DX битами из BX: DX:=DX or (BX shl CL)}
	shl bx,cl; or dx,bx
	{ удаляем из AX перенесенные (16-CL) бит, теперь DX:AX содержат все биты }
	sub cl,16; neg cl; shr ax,cl
	{ CL:=число бит в AX:DX }
	neg cl; add cl,16+8
	{ prFreeSize:=prFreeSize-1}
	dec es:tBitBuffer([di]).prFreeSize
      @Check:
      pop ds
      { запоминаем указатель на следующий байт основного буфера }
      mov word(es:tBitBuffer([di]).prBufferFreePtr),si
      { проверка числа бит }
      { CL:=CL-CH = число бит остатка }
      sub cl,ch; jb @NotOK
	{ достаточно бит }
	{ DX:AX:=биты данных; CL:=число бит }

	{ запоминаем число оставшихся бит в промежуточном буфере }
	mov es:tBitBuffer([di]).prImdBufBitsCount,cl

	{ копирование CH первых бит из DX в BX }
	mov bx,dx
	mov cl,16; sub cl,ch; shl bx,cl; shr bx,cl

	{ Удаление скопированных бит из DX:AX}
	shl ax,cl; mov cl,ch; shr dx,cl
	{ DX:=остаток бит}
	or dx,ax
    jmp @Store
	{ недостаточно бит - сохраняем остаток в промежуточном буфере и
	возвращаем FALSE }
      @NotOK:
	add cl,ch
	mov es:tBitBuffer([di]).prImdBufBitsCount,cl
	mov word(es:tBitBuffer([di]).prImdBuf),dx
    jmp @ExitFalse

    @Cont:

    { DX:=биты данных; CL:=число бит }

    { запоминаем число оставшихся бит в промежуточном буфере }
    mov es:tBitBuffer([di]).prImdBufBitsCount,cl

    { копирование CH первых бит из DX в BX }
    mov bx,dx
    mov cl,16; sub cl,ch; shl bx,cl; shr bx,cl

    { Удаление скопированных бит из DX}
    mov cl,ch; shr dx,cl

    @Store:
    { запоминаем остаток в промежуточном буфере }
    mov word(es:tBitBuffer([di]).prImdBuf),dx

    { AIndex:=BX }
    les si,AIndex; mov es:[si],bx

{$IfDef DebugBuf }
  push bx; mov al,ch; xor ah,ah; push ax;  call WriteIndexG;
{$EndIf Def DebugBuf }

    { биты получены успешно }
    mov ax,TRUE
  jmp @Exit

  @ExitFALSE:
    xor ax,ax; { данные кончились }

  @Exit:
end;
{$Else IfNDef Delphi}
register;
 { EAX -> Self; EDX -> AIndex; ECX = ABitsCount }
 var PIndex:pointer;
asm
  push edi; push ebx
  mov PIndex,AIndex
  { CH:=чряЁр°штрхьюх ўшёыю сшЄ}
  mov ch,ABitsCount
  { CL:=ўшёыю сшЄ юёЄрЄър }
  mov cl,tBitBuffer([Self]).prImdBufBitsCount
  { чруЁєчър юёЄрЄър фрээ√ї шч яЁюьхцєЄюўэюую сєЇхЁр т EDX }
  mov edx,dword(tBitBuffer([Self]).prImdBuf);
  { CL:=CL-CH = ўшёыю сшЄ юёЄрЄър }
  sub cl,ch;
  { яЁютхЁър ўшёыр сшЄ }
  jae @Cont { фюёЄрЄюўэю сшЄ }
    { эхфюёЄрЄюўэю сшЄ - ёўшЄ√трэшх фрээ√ї шч юёэютэюую сєЇхЁр }
    mov edi,tBitBuffer([Self]).prFreeSize
    or edi,edi; jz @ExitFALSE { яЁютхЁър эрышўш  фрээ√ї т юёэютэюь сєЇхЁх }
    { BL:=ўшёыю срщЄ, ъюЄюЁ√х эхюсїюфшью ёўшЄрЄ№}
    movzx ebx,cl; neg bl; add bl,7; shr bl,3;
    cmp edi,ebx;
    db $0F,$42,$DF {cmovb ebx,edi}
{    cmp edi,ebx; jae @SizeOK
      mov ebx,edi
    @SizeOK:}
      { prFreeSize:=prFreeSize-EBX}
      sub tBitBuffer([Self]).prFreeSize,ebx
      add cl,ch
      { [ESI]->ёыхфє■∙шщ срщЄ т юёэютэюь сєЇхЁх }
      push esi
      mov esi,tBitBuffer([Self]).prBufferFreePtr
      mov edi,Self

      { фы  Єюую, ўЄюс√ эх шч· Є№ шч сєЇхЁр ыш°эхх }
      { Єрсышўэ√щ яхЁхїюф, т чртшёшьюёЄш юЄ ўшёыр срщЄ }
      shl ebx,2; jmp dword ptr ([(Offset @JmpTbl)-4][ebx])
      @JmpTbl:  dd (OFFSET @1)
                dd (OFFSET @2)
                dd (OFFSET @3)
                dd (OFFSET @4)
      @1: { 1 срщЄ }
	xor eax,eax; lodsb
      jmp @ContX
      @2: { 2 срщЄр }
	xor eax,eax; lodsw;
      jmp @ContX
      @3: { 3 срщЄр }
	lodsw; shl eax,16; lodsb; rol eax,16;
      jmp @ContX
      @4: { 4 срщЄр }
	lodsd;
      @ContX:
      { чряюьшэрхь єърчрЄхы№ эр ёыхфє■∙шщ срщЄ юёэютэюую сєЇхЁр }
      mov tBitBuffer([edi]).prBufferFreePtr,esi;
      { BL:=ўшёыю чруЁєцхээ√ї шч сєЇхЁр сшЄ }
      shl bl,1;
      or cl,cl; jz @ZeroCL
        { фюяюыэ хь EDX сшЄрьш шч EAX: EDX:=EDX or (EAX shl CL)}
        mov esi,eax; shl esi,cl; or edx,esi
        { BL:=ўшёыю сшЄ т EAX:EDX }
        add bl,cl
        { єфры хь шч EAX яхЁхэхёхээ√х (32-CL) сшЄ, ЄхяхЁ№ EDX:EAX ёюфхЁцрЄ тёх сшЄ√ }
        sub cl,32; neg cl; shr eax,cl
      jmp @ContXX
      @ZeroCL: { !!! Pentium эх ёфтшурхЄ ЁхушёЄЁ эр 32 сшЄр }
        mov edx,eax
        xor eax,eax
      @ContXX:
      { CL:=ўшёыю сшЄ т EAX:EDX }
      mov cl,bl
      pop esi
      { яЁютхЁър ўшёыр сшЄ }
      { CL:=CL-CH = ўшёыю сшЄ юёЄрЄър }
      sub cl,ch; jb @NotOK
	{ фюёЄрЄюўэю сшЄ }
	{ EDX:EAX:=сшЄ√ фрээ√ї; CL:=ўшёыю сшЄ }

	{ чряюьшэрхь ўшёыю юёЄрт°шїё  сшЄ т яЁюьхцєЄюўэюь сєЇхЁх }
	mov tBitBuffer([edi]).prImdBufBitsCount,cl

	{ ъюяшЁютрэшх CH яхЁт√ї сшЄ шч EDX т EBX }
	mov ebx,edx
	mov cl,32; sub cl,ch; shl ebx,cl; shr ebx,cl

	{ ╙фрыхэшх ёъюяшЁютрээ√ї сшЄ шч EDX:EAX}
	shl eax,cl; mov cl,ch; shr edx,cl
	{ EDX:=юёЄрЄюъ сшЄ}
	or edx,eax

	{ Self=E└X:=EDI - тюёёЄрэртыштрхь Self }
        mov Self,edi
    jmp @Store
      @NotOK:
	{ эхфюёЄрЄюўэю сшЄ - ёюїЁрэ хь юёЄрЄюъ т яЁюьхцєЄюўэюь сєЇхЁх ш
	тючтЁр∙рхь FALSE }
	add cl,ch
	mov tBitBuffer([edi]).prImdBufBitsCount,cl
	mov dword(tBitBuffer([edi]).prImdBuf),edx
    jmp @ExitFalse

    @Cont:

    { EDX:=сшЄ√ фрээ√ї; CL:=ўшёыю сшЄ }

    { чряюьшэрхь ўшёыю юёЄрт°шїё  сшЄ т яЁюьхцєЄюўэюь сєЇхЁх }
    mov tBitBuffer([Self]).prImdBufBitsCount,cl

    { ъюяшЁютрэшх CH яхЁт√ї сшЄ шч EDX т EBX }
    mov ebx,edx
    mov cl,32; sub cl,ch; shl ebx,cl; shr ebx,cl

    { ╙фрыхэшх ёъюяшЁютрээ√ї сшЄ шч EDX}
    mov cl,ch; shr edx,cl

    @Store:
    { чряюьшэрхь юёЄрЄюъ т яЁюьхцєЄюўэюь сєЇхЁх }
    mov dword(tBitBuffer([Self]).prImdBuf),edx

    { AIndex:=EBX }
    mov edi,PIndex; mov [edi],ebx

{$IfDef DebugBuf }
  mov eax,ebx; movzx edx,ch; call WriteIndexG;
{$EndIf Def DebugBuf }

    { сшЄ√ яюыєўхэ√ єёях°эю }
    mov eax,TRUE
  jmp @Exit

  @ExitFALSE:
    xor eax,eax; { фрээ√х ъюэўшышё№ }

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

{ сброс остатка бит при чтении }
function  tBitBuffer.GetFlush:boolean;
  var n:byte;
begin
  {$IfOpt R+}
  if not (fRead in prFlags) then
    RunError(201);
  {$EndIf}
  if prImdBufBitsCount>8 then begin
    n:=prImdBufBitsCount div 8;
    if Size>=n then begin
      Inc(prFreeSize, prImdBufBitsCount);
      prBufferFreePtr:=tPBuffer(@prPBuffer^[Size]);
    end else begin
      RunError(201);
    end;
  end;
  GetFlush:=(prImdBufBitsCount>0);
  prImdBufBitsCount:=0;
end;

{$IfDef DebugBuf }
  var OldExitProc:pointer;

  procedure myExitProc; far;
  begin
    ExitProc:=OldExitProc;
    Close(fa);
    Close(fg);
  end;

BEGIN
  Assign(fa,'IndexesA.txt');
  Rewrite(fa);
  Assign(fg,'IndexesG.txt');
  Rewrite(fg);
  OldExitProc:=ExitProc;
  ExitProc:=@myExitProc;
  ta:=0;
  tg:=0;
{$EndIf Def Debug }
END.