(*  unit:        Thomas
    version:     10
    release:     Feb 2005
    developed:   2001-2005
    environment: Borland Delphi 7
    restrictions: requires at least an 80486 processor
    --------------------------------------------------
    author: Thomas Lackó
    web:    http://thomas.sk
    e-mail: thomas.lacko@gmail.com
*)

unit Thomas;

INTERFACE

uses SysUtils,Classes;
const UnitVersion = $0502100A;

// basic routines

const INTBSIZE=8*SizeOf(Integer);

function  Min(const A,B:Shortint):Shortint; register; overload;
function  Min(const A,B:Byte):Byte;         register; overload;
function  Min(const A,B:Smallint):Smallint; register; overload;
function  Min(const A,B:Word):Word;         register; overload;
function  Min(const A,B:Longint):Longint;   register; overload;
function  Min(const A,B:Longword):Longword; register; overload;
function  Min(      A,B:Int64):Int64;       pascal;   overload;
function  Min(      A,B:Real):Real;                   overload;

function  Max(const A,B:Shortint):Shortint; register; overload;
function  Max(const A,B:Byte):Byte;         register; overload;
function  Max(const A,B:Smallint):Smallint; register; overload;
function  Max(const A,B:Word):Word;         register; overload;
function  Max(const A,B:Longint):Longint;   register; overload;
function  Max(const A,B:Longword):Longword; register; overload;
function  Max(      A,B:Int64):Int64;       pascal;   overload;
function  Max(      A,B:Real):Real;                   overload;

procedure Xchg(var A,B:Shortint); register; overload;
procedure Xchg(var A,B:Byte);     register; overload;
procedure Xchg(var A,B:Char);     register; overload;
procedure Xchg(var A,B:Smallint); register; overload;
procedure Xchg(var A,B:Word);     register; overload;
procedure Xchg(var A,B:Longint);  register; overload;
procedure Xchg(var A,B:Longword); register; overload;
procedure Xchg(var A,B:Int64);    pascal;   overload;
procedure Xchg(var A,B:Real);     pascal;   overload;

function  ByteSwap(X:Smallint):Smallint; register; overload;
function  ByteSwap(X:Word):Word;         register; overload;
function  ByteSwap(X:Longint):Longint;   register; overload;
function  ByteSwap(X:Longword):Longword; register; overload;
function  ByteSwap(X:Int64):Int64;       register; overload;

function  BitCount(i:Integer):Integer;   register;
function  BitScanLS(i:Integer):Integer;  register;
function  BitScanMS(i:Integer):Integer;  register;
function  Log(i:Integer):Integer;        register;

function  BoundDown2pow(i,b:Integer):Integer; register;
function  BoundUp2pow(i,b:Integer):Integer;   register;
function  BoundDown(i,b:Integer):Integer;     register;
function  BoundUp(i,b:Integer):Integer;       register;

function  IndexOfFirstB     (const A;Len:Integer;K:Byte):Integer; register;
function  IndexOfFirstOtherB(const A;Len:Integer;K:Byte):Integer; register;
function  IndexOfLastB      (const A;Len:Integer;K:Byte):Integer; register;
function  IndexOfLastOtherB (const A;Len:Integer;K:Byte):Integer; register;
function  OnlyBytes         (const A;Len:Integer;K:Byte):Boolean; register;

procedure FillInt(var X;Count,Value:Integer); register;
function  IndexOfFirst     (const A:array of Integer;i:Integer):Integer; register;
function  IndexOfFirstOther(const A:array of Integer;i:Integer):Integer; register;
function  IndexOfLast      (const A:array of Integer;i:Integer):Integer; register;
function  IndexOfLastOther (const A:array of Integer;i:Integer):Integer; register;
function  OnlyInts         (const A:array of Integer;i:Integer):Boolean; register;

function  CommonPrefixLength(const A,B:string):Integer; overload; register;
function  CommonPrefixLength(const A,B:PChar ):Integer; overload; register;
function  CommonSuffixLength(const A,B:string):Integer; {overload;} register;
{function  CommonSuffixLength(const A,B:PChar ):Integer; overload; register;}

function  IntToStrEx(Value,Len:Integer;K:Char):string;       overload;
function  IntToStrEx(Value:Int64;Len:Integer;K:Char):string; overload;

// bit streams

const
  BitStreamRegSize=INTBSIZE         deprecated;
  BitStreamRegSize8=SizeOf(Integer) deprecated;
type
  TBitStreamMode=(bmRead,bmWrite);
  TBitStream=class
   protected
    RegBuf,BitPos:Integer;
    procedure ReadReg; virtual; abstract;
    procedure WriteReg; virtual; abstract;
   private
    M:TBitStreamMode;
   public
    property  Mode:TBitStreamMode read M;
    constructor Create(Mode:TBitStreamMode);
    function  Read(Size:Integer):Integer;
    procedure Write(Size,Code:Integer);
    function  Bound(BitCount:Integer):Boolean;
    destructor Destroy; override;
  end;
  TDirectBitStream=class(TBitStream)
   protected
    Stream:TStream;
    procedure ReadReg; override;
    procedure WriteReg; override;
   public
    constructor Create(S:TStream;Mode:TBitStreamMode);
  end;
  TSegmentedBitStream=class(TBitStream)
   protected
    Buffer:Pointer;
    BufferSize,BufPos:Integer;
    procedure ReadReg; override;
    procedure WriteReg; override;
    procedure ReadBuffer; virtual; abstract;
    procedure WriteBuffer(Size:Integer); virtual; abstract;
   public
    constructor Create(Mode:TBitStreamMode;BufSize:Integer);
    procedure ClearBuffer;
    destructor Destroy; override;
  end;
  TBufferedBitStream=class(TSegmentedBitStream)
   protected
    Stream:TStream;
    procedure ReadBuffer; override;
    procedure WriteBuffer(Size:Integer); override;
   public
    constructor Create(S:TStream;Mode:TBitStreamMode;BufSize:Integer=0);
  end;

// lexicographic trees

const
  tmPreorder=$01; tmInorder=$02; tmPostorder=$04; tmExisting=$10; tmMissing=$20;
  vtPositive=$01; vtZero=$02; vtNegative=$04; vtAny=$07;
type
  TLexTree=class;
  TLexTree_class=class of TLexTree;
  TLexTree_field=record
    Len:Integer; S:PChar; Tree:TLexTree;
  end;
  TLexProcessFunc=function(L:TLexTree;mode,i:Integer):Integer;
  TLexTree=class
   private
    function  BlockSize:Integer;
   protected
    K:PChar;
    A:array of TLexTree_field;
    procedure Change(i,l:Integer);
    procedure Insert(i:Integer;const S:PChar);
    procedure Remove(i:Integer);
    function  StringPos(const S:PChar):Integer;
    function  StringIndex(const S:PChar):Integer;
   public
    C:Integer;
    constructor Create; virtual;
    procedure Clear;
    function  Add(const S:PChar):Integer; dynamic;
    function  Delete(const S:PChar):Boolean; dynamic;
    function  Count(const S:PChar):Integer;
    function  Traverse(OnProcess:TLexProcessFunc;mode,i:Integer):Integer;
    destructor Destroy; override;
  end;
  TTaggedLexTree=class(TLexTree)
    T:Integer;
    function  Tag(const S:PChar):Integer;
    function  CountTag(tg:Integer):Integer;
    function  CountType(tt:Integer):Integer;
  end;
  TLexStringsTree=class(TTaggedLexTree)
    function  IndexOf(const S:PChar):Integer;
    procedure Get(i,d:Integer;var S:string);
    function  Add(const S:PChar):Integer; override;
    function  Delete(const S:PChar):Boolean; override;
  end;
  TLexStrings=class(TStrings)
   private
    L:TLexStringsTree; FCount:Integer;
    {FDuplicates:TDuplicates;}
   protected
    function  GetCount:Integer; override;
    function  Get(Index:Integer):string; override;
    procedure Put(Index:Integer;const S:string); override;
   public
    constructor Create;
    procedure Clear; override;
    function  Add(const S:string):Integer; override;
    procedure Delete(Index:Integer); override;
    function  IndexOf(const S:string):Integer; override;
    procedure Insert(Index:Integer;const S:string); override;
    procedure Exchange(Index1,Index2:Integer); override;
    destructor Destroy; override;
    {property Duplicates:TDuplicates read FDuplicates write FDuplicates;}
  end;

function TaggedLexTree_Set(L:TLexTree;mode,i:Integer):Integer;
function TaggedLexTree_Index(L:TLexTree;mode,i:Integer):Integer;

// special classes

const PriorityQueue_DELTA=4;
type
  TChangingObject=class(TPersistent)
   private
    U:Integer;
   protected
    property  UpdateCount:Integer read U;
    procedure SetUpdateState(Updating:Boolean); virtual;
   public
    procedure BeginUpdate;
    procedure EndUpdate;
  end;
  TDichCompareFunc=function(A,B:TObject):Boolean;
  TPriorityQueue=class(TChangingObject)
   private
    A:array of TObject; z:Integer;
    procedure Exchange(i,j:Integer);
    procedure HeapifyTop;
    procedure HeapifyBottom;
   protected
    procedure SetUpdateState(Updating:Boolean); override;
   public
    Compare:TDichCompareFunc;
    OwnsObjects:Boolean;
    property  Size:Integer read z;
    constructor Create(cmp:TDichCompareFunc;owns:Boolean);
    procedure Clear;
    procedure Push(o:TObject);
    function  Pop:TObject;
    destructor Destroy; override;
  end;

// integer sets

type
  TIntegerSet=class(TChangingObject)
   protected
    procedure AssignTo(Dest:TPersistent); override;
   public
    procedure Clear; virtual; abstract;
    function  Empty:Boolean; virtual;
    function  Count:Integer; virtual; abstract;
    function  Min:Integer;   virtual; abstract;
    function  Max:Integer;   virtual; abstract;
    function  Member(i:Integer):Boolean; virtual; abstract;
    procedure Include(i:Integer); virtual; abstract;
    procedure Exclude(i:Integer); virtual; abstract;
  end;
  TIntegerMap=class(TIntegerSet)
   private
    A:array of Integer; m1,m2:Integer;
   protected
    procedure SetUpdateState(Updating:Boolean); override;
    procedure Optimize;
   public
    procedure Assign(Source:TPersistent); override;
    procedure Clear; override;
    function  Empty:Boolean; override;
    function  Count:Integer; override;
    function  Min:Integer;   override;
    function  Max:Integer;   override;
    function  Member(i:Integer):Boolean; override;
    procedure Include(i:Integer); override;
    procedure Exclude(i:Integer); override;
  end;
  IntegerArray=array of Integer;
  TListMode=set of (lmMulti,lmSorted);
  TIntegerList=class(TIntegerSet)
   private
    M:TListMode;
    A:IntegerArray;
    function  RecIndexFor(i,l,r:Integer):Integer;
    procedure SetMode(Mode:TListMode);
   protected
    IsSorted:Boolean;
    procedure AssignTo(Dest:TPersistent); override;
    procedure SetUpdateState(Updating:Boolean); override;
    function  IndexFor(i:Integer):Integer;
   public
    procedure Assign(Source:TPersistent); override;
    constructor Create(Mode:TListMode=[]);
    property  Mode:TListMode read M write SetMode;
    procedure Clear; override;
    function  Empty:Boolean; override;
    function  Count:Integer; override;
    function  Min:Integer;   override;
    function  Max:Integer;   override;
    function  Member(i:Integer):Boolean; override;
    procedure Include(i:Integer); override;
    procedure Exclude(i:Integer); override;
    function  CountItem(i:Integer):Integer;
    procedure Sort;
  end;
  (*
  TiInterval=record
    l,r:Integer;
  end;
  TiIntervals=class(TIntegerSet)
   private
    A:array of TiInterval;
    function  RecIndexFor(i,l,r:Integer):Integer;
   protected
    procedure AssignTo(Dest:TPersistent); override;
    function  IndexFor(i:Integer):Integer;
   public
    procedure Assign(Source:TPersistent); override;
    procedure Clear; override;
    function  Empty:Boolean; override;
    function  Count:Integer; override;
    function  Min:Integer; override;
    function  Max:Integer; override;
    function  Member(i:Integer):Boolean; override;
    procedure Include(i:Integer); override;
    procedure Exclude(i:Integer); override;
    procedure IncludeInterval(l,r:Integer);
    procedure ExcludeInterval(l,r:Integer);
  end;
  *)

// synchronization

type
  TSemaphore=record
    Value,MaxValue,Lowered,Raised:Longint;
  end;

procedure InitSemaphore(var S:TSemaphore;Init,Max:Integer); register;
procedure SemaphoreDown(var S:TSemaphore); register;
procedure SemaphoreUp  (var S:TSemaphore); register;
function  IncSharedInt(var I:Integer;By:Integer):Integer; register;

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
IMPLEMENTATION

type PByte=^Byte;

//--------------- BASIC ROUTINES --------------------------------------------

{ minimum }

function Min(const A,B:Shortint):Shortint;
// input: al=A, dl=B
// output: al=minimum
asm
  cmp  al,dl
  jle  @exit
  mov  al,dl
@exit:
end;

function Min(const A,B:Byte):Byte;
// input: al=A, dl=B
// output: al=minimum
asm
  cmp  al,dl
  jbe  @exit
  mov  al,dl
@exit:
end;

function Min(const A,B:Smallint):Smallint;
// input: ax=A, dx=B
// output: ax=minimum
asm
  cmp  ax,dx
  jle  @exit
  xchg eax,edx
@exit:
end;

function Min(const A,B:Word):Word;
// input: ax=A, dx=B
// output: ax=minimum
asm
  cmp  ax,dx
  jbe  @exit
  xchg eax,edx
@exit:
end;

function Min(const A,B:Longint):Longint;
// input: eax=A, edx=B
// output: eax=minimum
asm
  cmp  eax,edx
  jle  @exit
  xchg eax,edx
@exit:
end;

function Min(const A,B:Longword):Longword;
// input: eax=A, edx=B
// output: eax=minimum
asm
  cmp  eax,edx
  jbe  @exit
  xchg eax,edx
@exit:
end;

function Min(A,B:Int64):Int64;
// input: [epb+16]=A, [ebp+8]=B
// output: edx:eax=minimum
asm
  mov  eax,dword ptr [A]
  mov  edx,dword ptr [A+4]
  cmp  edx,dword ptr [B+4]
  jl   @exit
  jg   @change
  cmp  eax,dword ptr [B]
  jbe  @exit
@change:
  mov  eax,dword ptr [B]
  mov  edx,dword ptr [B+4]
@exit:
end;

function Min(A,B:Real):Real;
begin if A<B then Result:=A else Result:=B end;

{ maximum }

function Max(const A,B:Shortint):Shortint;
// input: al=A, dl=B
// output: al=maximum
asm
  cmp  al,dl
  jge  @exit
  mov  al,dl
@exit:
end;

function Max(const A,B:Byte):Byte;
// input: al=A, dl=B
// output: al=maximum
asm
  cmp  al,dl
  jae  @exit
  mov  al,dl
@exit:
end;

function Max(const A,B:Smallint):Smallint;
// input: ax=A, dx=B
// output: ax=maximum
asm
  cmp  ax,dx
  jge  @exit
  xchg eax,edx
@exit:
end;

function Max(const A,B:Word):Word;
// input: ax=A, dx=B
// output: ax=maximum
asm
  cmp  ax,dx
  jae  @exit
  xchg eax,edx
@exit:
end;

function Max(const A,B:Longint):Longint;
// input: eax=A, edx=B
// output: eax=maximum
asm
  cmp  eax,edx
  jge  @exit
  xchg eax,edx
@exit:
end;

function Max(const A,B:Longword):Longword;
// input: eax=A, edx=B
// output: eax=maximum
asm
  cmp  eax,edx
  jae  @exit
  xchg eax,edx
@exit:
end;

function Max(A,B:Int64):Int64;
// input: [epb+16]=A, [ebp+8]=B
// output: edx:eax=maximum
asm
  mov  eax,dword ptr [A]
  mov  edx,dword ptr [A+4]
  cmp  edx,dword ptr [B+4]
  jg   @exit
  jl   @change
  cmp  eax,dword ptr [B]
  jae  @exit
@change:
  mov  eax,dword ptr [B]
  mov  edx,dword ptr [B+4]
@exit:
end;

function Max(A,B:Real):Real;
begin if A>B then Result:=A else Result:=B end;

{ exchanging }

procedure Xchg(var A,B:Shortint);
// input: eax=@A, edx=@B
asm
  mov  cl,[eax]
  xchg cl,[edx]
  mov  [eax],cl
end;

procedure Xchg(var A,B:Byte);
// input: eax=@A, edx=@B
asm
  mov  cl,[eax]
  xchg cl,[edx]
  mov  [eax],cl
end;

procedure Xchg(var A,B:Char);
// input: eax=@A, edx=@B
asm
  mov  cl,[eax]
  xchg cl,[edx]
  mov  [eax],cl
end;

procedure Xchg(var A,B:Smallint);
// input: eax=@A, edx=@B
asm
  mov  cx,[eax]
  xchg cx,[edx]
  mov  [eax],cx
end;

procedure Xchg(var A,B:Word);
// input: eax=@A, edx=@B
asm
  mov  cx,[eax]
  xchg cx,[edx]
  mov  [eax],cx
end;

procedure Xchg(var A,B:Longint);
// input: eax=@A, edx=@B
asm
  mov  ecx,[eax]
  xchg ecx,[edx]
  mov  [eax],ecx
end;

procedure Xchg(var A,B:Longword);
// input: eax=@A, edx=@B
asm
  mov  ecx,[eax]
  xchg ecx,[edx]
  mov  [eax],ecx
end;

procedure Xchg(var A,B:Int64);
// input: eax=@A, edx=@B
asm
  mov  ecx,[eax]
  xchg ecx,[edx]
  mov  [eax],ecx
  mov  ecx,[eax+4]
  xchg ecx,[edx+4]
  mov  [eax+4],ecx
end;

procedure Xchg(var A,B:Real);
// input: eax=@A, edx=@B
asm
  mov  ecx,[eax]
  xchg ecx,[edx]
  mov  [eax],ecx
  mov  ecx,[eax+4]
  xchg ecx,[edx+4]
  mov  [eax+4],ecx
end;

{ byte swapping }

function ByteSwap(X:Smallint):Smallint;
// input: ax=X, output: ax=swapped
asm xchg ah,al; end;

function ByteSwap(X:Word):Word;
// input: ax=X, output: ax=swapped
asm xchg ah,al; end;

function ByteSwap(X:Longint):Longint;
// input: eax=X, output: eax=swapped
asm bswap eax; end;

function ByteSwap(X:Longword):Longword;
// input: eax=X, output: eax=swapped
asm bswap eax; end;

function ByteSwap(X:Int64):Int64;
// input: [ebp+8]=X, output: edx:eax=swapped
asm
  mov eax,dword [X+4]
  bswap eax
  mov edx,dword [X]
  bswap edx
end;

{ bit operations & bounding }

{$IF SizeOf(Integer)=4}

function BitCount(i:Integer):Integer; register;
// input: eax = i
// output: eax = number of bits
asm
  xor edx,edx
  mov ecx,32
@nextbit:
  shr eax,1
  adc edx,0
  loop @nextbit
  xchg eax,edx
end;

function BitScanLS(i:Integer):Integer; register;
// input: eax = i
// output: eax = index of first 1 (-1 for none)
asm
  bsf eax,eax
  jnz @exit
  mov eax,-1
@exit:
end;

function BitScanMS(i:Integer):Integer; register;
// input: eax = i
// output: eax = index of last 1 (-1 for none)
asm
  bsr eax,eax
  jnz @exit
  mov eax,-1
@exit:
end;

function Log(i:Integer):Integer; register;
// alias for the BitScanMS function
asm
  bsr eax,eax
  jnz @exit
  mov eax,-1
@exit:
end;

function BoundDown2pow(i,b:Integer):Integer;
// input: eax=i, edx=b
// output: eax=bouded
asm
  neg edx
  and eax,edx
end;

function BoundUp2pow(i,b:Integer):Integer;
// input: eax=i, edx=b
// output: eax=bouded
asm
  dec edx
  add eax,edx
  not edx
  and eax,edx
end;

function BoundDown(i,b:Integer):Integer;
// input: eax=i, edx=b
// output: eax=bouded
asm
  push ebx
  mov  ecx,eax
  mov  ebx,edx
  xor  edx,edx
  div  ebx
  xchg eax,ecx
  sub  eax,edx
  pop  ebx
end;

function BoundUp(i,b:Integer):Integer;
// input: eax=i, edx=b
// output: eax=bouded
asm
  push ebx
  add  eax,edx
  dec  eax
  mov  ecx,eax
  mov  ebx,edx
  xor  edx,edx
  div  ebx
  xchg eax,ecx
  sub  eax,edx
  pop  ebx
end;

{$ELSE}

function BitCount(i:Integer):Integer;
begin
  Result:=0;
  while i<>0 do begin
    if i and 1<>0 then Inc(Result);
    i:=i shr 1;
  end;
end;

function BitScanLS(i:Integer):Integer;
begin
  if i=0 then Result:=-1
  else begin
    Result:=0;
    while i and 15=0 do begin
      Inc(Result,4); i:=i shr 4;
    end;
    while i and 1=0 do begin
      Inc(Result); i:=i shr 1;
    end;
  end;
end;

function BitScanMS(i:Integer):Integer;
begin
  if i=0 then Result:=-1
  else begin
    Result:=INTBSIZE-1;
    while i and not (1 shl (INTBSIZE-4)-1)=0 do begin
      Dec(Result,4); i:=i shl 4;
    end;
    while i and (1 shl (INTBSIZE-1))=0 do begin
      Dec(Result); i:=i shl 1;
    end;
  end;
end;

function Log(i:Integer):Integer;
asm jmp BitScanMS; end;

function BoundDown2pow(i,b:Integer):Integer;
begin Result:=i and not (b-1) end;

function BoundUp2pow(i,b:Integer):Integer;
begin Dec(b); Result:=(i+b) and not b; end;

function BoundDown(i,b:Integer):Integer;
begin Result:=i-i mod b end;

function BoundUp(i,b:Integer):Integer;
begin Result:=i+b-1; Dec(Result,Result mod b); end;

{$IFEND}

{ byte arrays }

{$IF SizeOf(Integer)=4}

function IndexOfFirstB(const A;Len:Integer;K:Byte):Integer; register;
// eax=@A, edx=Len, cl=K
asm
  push edi
  or   edx,edx
  jz   @zero
  xchg ecx,edx
  mov  edi,eax
  xchg edx,eax
  repne scasb
  jne  @zero
  mov  eax,edi
  sub  eax,edx
  jmp  @exit
@zero:
  xor  eax,eax
@exit:
  dec  eax
  pop  edi
end;

function IndexOfFirstOtherB(const A;Len:Integer;K:Byte):Integer; register;
// eax=@A, edx=Len, cl=K
asm
  push edi
  or   edx,edx
  jz   @zero
  xchg ecx,edx
  mov  edi,eax
  xchg edx,eax
  repe scasb
  je   @zero
  mov  eax,edi
  sub  eax,edx
  jmp  @exit
@zero:
  xor  eax,eax
@exit:
  dec  eax
  pop  edi
end;

function IndexOfLastB(const A;Len:Integer;K:Byte):Integer; register;
// eax=@A, edx=Len, cl=K
asm
  add  eax,edx
  dec  eax
  xchg ecx,edx
  jcxz @zero
  xchg edi,eax
  xchg eax,edx
  std
  repne scasb
  cld
  mov  eax,ecx
  je   @exit
  dec  eax
@exit:
  mov  edi,edx
  ret
@zero:
  mov  eax,-1
end;

function IndexOfLastOtherB(const A;Len:Integer;K:Byte):Integer; register;
asm
  {_} mov eax,-1
end;

function OnlyBytes(const A;Len:Integer;K:Byte):Boolean; register;
// eax=@A, edx=Len, cl=K
asm
  mov  ecx,edx
  jcxz @exit
  xchg edi,eax
  xchg eax,edx
  repe scasb
  mov  edi,edx
@exit:
  sete al
end;

{$ELSE}

function IndexOfFirst(const A:array of Integer;i:Integer):Integer;
begin
  {_} Result:=-1;
end;

function IndexOfFirstOther(const A:array of Integer;i:Integer):Integer;
begin
  {_} Result:=-1;
end;

function IndexOfLast(const A:array of Integer;i:Integer):Integer;
begin
  {_} Result:=-1;
end;

function IndexOfLastOther(const A:array of Integer;i:Integer):Integer;
begin
  {_} Result:=-1;
end;

function OnlyBytes(const A;Len:Integer;K:Byte):Boolean;
var j:Integer; B:^Byte;
begin
  B:=@A;
  while (Len>0) and (B^=K) do begin
    Inc(B); Dec(Len);
  end;
  Result:=Len=0;
end;

{$IFEND}

{ integer arrays }

{$IF SizeOf(Integer)=4}

procedure FillInt(var X;Count,Value:Integer);
// eax=@X, edx=Count, ecx=Value
asm
  xchg edi,eax
  xchg eax,ecx
  xchg ecx,edx
  jcxz @exit
  rep  stosd
  @exit:
  mov  edi,edx
end;

function IndexOfFirst(const A:array of Integer;i:Integer):Integer;
// eax=A, edx=High(A), ecx=i
asm
  push edi
  inc  edx
  jz   @zero
  xchg ecx,edx
  mov  edi,eax
  xchg edx,eax
  repne scasd
  jne  @zero
  mov  eax,edi
  sub  eax,edx
  shr  eax,2
  jmp  @exit
@zero:
  xor  eax,eax
@exit:
  dec  eax
  pop  edi
end;

function IndexOfFirstOther(const A:array of Integer;i:Integer):Integer;
// eax=A, edx=High(A), ecx=i
asm
  push edi
  inc  edx
  jz   @zero
  xchg ecx,edx
  mov  edi,eax
  xchg edx,eax
  repe scasd
  je   @zero
  mov  eax,edi
  sub  eax,edx
  shr  eax,2
  jmp  @exit
@zero:
  xor  eax,eax
@exit:
  dec  eax
  pop  edi
end;

function IndexOfLast(const A:array of Integer;i:Integer):Integer; register;
// eax=A, edx=High(A), ecx=i
asm
  sal  edx,2
  add  eax,edx
  sar  edx,2
  js   @zero
  inc  edx
  xchg ecx,edx
  xchg edi,eax
  xchg eax,edx
  std
  repne scasd
  cld
  mov  eax,ecx
  je   @exit
  dec  eax
@exit:
  mov  edi,edx
  ret
@zero:
  xchg eax,edx
end;

function IndexOfLastOther(const A:array of Integer;i:Integer):Integer; register;
// eax=A, edx=High(A), ecx=i
asm
  sal  edx,2
  add  eax,edx
  sar  edx,2
  js   @zero
  inc  edx
  xchg ecx,edx
  xchg edi,eax
  xchg eax,edx
  std
  repe scasd
  cld
  mov  eax,ecx
  jne  @exit
  dec  eax
@exit:
  mov  edi,edx
  ret
@zero:
  xchg eax,edx
end;

function OnlyInts(const A:array of Integer;i:Integer):Boolean;
// eax=A, edx=High(A), ecx=i
asm
  mov  ecx,edx
  inc  ecx
  jz   @exit
  xchg edi,eax
  xchg eax,edx
  repe scasd
  mov  edi,edx
@exit:
  sete al
end;

{$ELSE}

procedure FillInt(var X;Count,Value:Integer);
var i:^Integer;
begin
  i:=@X;
  while Count>0 do begin
    i^:=Value; Inc(i); Dec(Count);
  end;
end;

function IndexOfFirst(const A:array of Integer;i:Integer):Integer;
begin
  Result:=0;
  while (Result<=High(A)) and (A[Result]<>i) do Inc(Result);
  if Result>High(A) then Result:=-1;
end;

function IndexOfFirstOther(const A:array of Integer;i:Integer):Integer;
begin
  Result:=0;
  while (Result<=High(A)) and (A[Result]=i) do Inc(Result);
  if Result>High(A) then Result:=-1;
end;

function IndexOfLast(const A:array of Integer;i:Integer):Integer;
begin
  Result:=High(A);
  while (Result>=0) and (A[Result]<>i) do Dec(Result);
end;

function IndexOfLastOther(const A:array of Integer;i:Integer):Integer;
begin
  Result:=High(A);
  while (Result>=0) and (A[Result]=i) do Dec(Result);
end;

function OnlyInts(const A:array of Integer;i:Integer):Boolean;
var j:Integer;
begin
  j:=High(A);
  if j<0 then Result:=True
  else begin
    while (j>=0) and (A[j]=i) do Dec(j);
    Result:=j<0;
  end;
end;

{$IFEND}

{ string functions }

{$IF SizeOf(Integer)=4}

function CommonPrefixLength(const A,B:string):Integer;
// eax=A, edx=B
asm
  or   eax,eax
  jz   @exit
  xchg eax,edx
  or   eax,eax
  jz   @exit
  mov  ecx,[eax-4] // Length(B)
  cmp  ecx,[edx-4] // Length(A)
  jle  @scan
  mov  ecx,[edx-4]
@scan:
  push ecx
  xchg eax,esi
  xchg edx,edi
  repe cmpsb
  jne  @count
  dec  ecx
@count:
  xchg eax,esi
  xchg edx,edi
  pop  eax
  sub  eax,ecx
  dec  eax
@exit:
end;

function CommonSuffixLength(const A,B:string):Integer;
// eax=A, edx=B
asm
  or   eax,eax
  jz   @exit
  xchg eax,edx
  or   eax,eax
  jz   @exit
  mov  ecx,[eax-4] // Length(B)
  cmp  ecx,[edx-4] // Length(A)
  jle  @scan
  mov  ecx,[edx-4]
@scan:
  push ecx
  add  eax,[eax-4]
  dec  eax
  add  edx,[edx-4]
  dec  edx
  xchg eax,esi
  xchg edx,edi
  std
  repe cmpsb
  cld
  jne  @count
  dec  ecx
@count:
  xchg eax,esi
  xchg edx,edi
  pop  eax
  sub  eax,ecx
  dec  eax
@exit:
end;

function CommonPrefixLength(const A,B:PChar):Integer;
// eax=A, edx=B
asm
  push esi
  xchg esi,eax
  mov  ecx,edx
@next:
  lodsb
  mov  ah,[edx]
  test al,ah
  jz   @exit // (AL=0) or (AH=0) or (AL<>AH) if jumps
  cmp  al,ah
  jne  @exit // (AL<>AH) if jumps
  inc  edx
  jmp  @next
@exit:
  pop  esi
  xchg eax,edx
  sub  eax,ecx
end;

{$ELSE}

function CommonPrefixLength(const A,B:string):Integer;
var i,l:Integer;
begin
  l:=Min(Length(A),Length(B)); i:=1;
  while (i<=l) and (A[i]=B[i]) do Inc(i);
  Result:=i-1;
end;

function CommonSuffixLength(const A,B:string):Integer;
var i,l1,l2:Integer;
begin
  l1:=Length(A); l2:=Length(B); i:=0;
  while (i<l1) and (i<l2) and (A[l1-i]=B[l2-i]) do Inc(i);
  Result:=i;
end;

function CommonPrefixLength(const A,B:PChar):Integer;
var x,y:PChar;
begin
  Result:=0; x:=A; y:=B;
  while (x^<>#0) and (y^<>#0) and (x^=y^) do begin
    Inc(Result); Inc(x); Inc(y);
  end;
end;

{function CommonSuffixLength(const A,B:PChar):Integer;
var x,y:PChar;
begin
  Result:=0; x:=StrEnd(A)-1; y:=StrEnd(B)-1;
  while (x>A) and (y>B) and (x^=y^) do begin
    Inc(Result); Dec(x); Dec(y);
  end;
end;}

{$IFEND}

function IntToStrEx(Value,Len:Integer;K:Char):string;
var OldLen:Integer;
begin
  Result:=IntToStr(Value); OldLen:=Length(Result);
  if OldLen<Len then begin
    SetLength(Result,Len);
    Move(Result[1],Result[Len-OldLen+1],OldLen);
    FillChar(Result[1],Len-OldLen,K);
  end;
end;

function IntToStrEx(Value:Int64;Len:Integer;K:Char):string;
var OldLen:Integer;
begin
  Result:=IntToStr(Value); OldLen:=Length(Result);
  if OldLen<Len then begin
    SetLength(Result,Len);
    Move(Result[1],Result[Len-OldLen+1],OldLen);
    FillChar(Result[1],Len-OldLen,K);
  end;
end;

//--------------- BIT STREAMS -----------------------------------------------

{ TBitStream }

constructor TBitStream.Create(Mode:TBitStreamMode);
begin
  M:=Mode;
  if Mode=bmRead then BitPos:=INTBSIZE
  else begin
    BitPos:=0; RegBuf:=0;
  end;
end;

function TBitStream.Read(Size:Integer):Integer;
begin
  if BitPos>=INTBSIZE then begin
    ReadReg; BitPos:=0;
  end;
  if Size=1 then begin
    Result:=(RegBuf shr BitPos) and 1; Inc(BitPos);
  end
  else begin
    Result:=(RegBuf shr BitPos) and (1 shl Size-1);
    Inc(BitPos,Size);
    if BitPos>INTBSIZE then begin
      ReadReg; Dec(BitPos,INTBSIZE);
      Result:=Result or (RegBuf and (1 shl BitPos-1) shl (Size-BitPos));
    end;
  end;
end;

procedure TBitStream.Write(Size,Code:Integer);
begin
  Code:=Code and (1 shl Size-1);
  RegBuf:=RegBuf or (Code shl BitPos); Inc(BitPos,Size);
  if BitPos>=INTBSIZE then begin
    WriteReg; Dec(BitPos,INTBSIZE);
    RegBuf:=Code shr (Size-BitPos);
  end;
end;

function TBitStream.Bound(BitCount:Integer):Boolean;
var q:Integer;
begin
  q:=BitScanMS(BitCount);
  Result:=(q>=0) and (q<=INTBSIZE) and (BitCount and not (1 shl q)=0);
  if not Result then Exit; // invalid parameter
  if BitPos<>0 then begin
    q:=BoundUp2pow(BitPos,BitCount)-BitPos;
    if M=bmRead then Read(q) else Write(q,0);
  end;
end;

destructor TBitStream.Destroy;
begin
  if (M=bmWrite) and (BitPos>0) then WriteReg;
end;

{ TDirectBitStream }

constructor TDirectBitStream.Create(S:TStream;Mode:TBitStreamMode);
begin inherited Create(Mode); Stream:=S; end;

procedure TDirectBitStream.ReadReg;
begin Stream.Read(RegBuf,SizeOf(Integer)) end;

procedure TDirectBitStream.WriteReg;
begin Stream.Write(RegBuf,SizeOf(Integer)) end;

{ TSegmentedBitStream }

constructor TSegmentedBitStream.Create(Mode:TBitStreamMode;BufSize:Integer);
begin
  inherited Create(Mode);
  if Mode=bmRead then BufPos:=BufSize else BufPos:=0;
  BufferSize:=BufSize; GetMem(Buffer,BufSize);
end;

procedure TSegmentedBitStream.ReadReg;
var B:Pointer; q,x:Integer;
begin
  if BufPos>=BufferSize then begin
    ReadBuffer; BufPos:=0;
  end;
  B:=Buffer; Inc(PByte(B),BufPos);
  if BufPos<=BufferSize-SizeOf(Integer) then begin
    RegBuf:=Integer(B^); Inc(BufPos,SizeOf(Integer));
  end
  else begin // divided code
    x:=0; q:=0;
    repeat
      x:=x or Byte(B^) shl (q shl 3); Inc(PByte(B)); Inc(q);
    until q=BufferSize-BufPos;
    ReadBuffer; BufPos:=(INTBSIZE-q shl 3) div 8;
    RegBuf:=x or Integer(Buffer^) shl (q shl 3);
  end;
end;

procedure TSegmentedBitStream.WriteReg;
var B:Pointer; q:Integer;
begin
  B:=Buffer; Inc(PByte(B),BufPos);
  if BufPos<=BufferSize-SizeOf(Integer) then begin
    Integer(B^):=RegBuf; Inc(BufPos,SizeOf(Integer));
    if BufPos=BufferSize then begin
      WriteBuffer(BufPos); BufPos:=0;
    end;
  end
  else begin // divide code
    q:=0;
    repeat
      Byte(B^):=Byte(RegBuf); Inc(PByte(B)); RegBuf:=RegBuf shr 8; Inc(q);
    until q=BufferSize-BufPos;
    WriteBuffer(BufferSize); BufPos:=(INTBSIZE-q shl 3) div 8;
    Integer(Buffer^):=RegBuf;
  end;
end;

procedure TSegmentedBitStream.ClearBuffer;
var q:Byte; B:PByte;
begin
  if M=bmWrite then begin
    q:=0; B:=Buffer; Inc(B,BufPos);
    while BitPos>q do begin
      B^:=Byte(RegBuf); RegBuf:=RegBuf shr 8; Inc(B); Inc(q,8);
    end;
    if (BufPos>0) or (BitPos>0) then begin
      WriteBuffer(BufPos+(BitPos+7) div 8); BitPos:=0;
    end;
  end
  else begin
    BitPos:=INTBSIZE; BufPos:=BufferSize;
  end;
end;

destructor TSegmentedBitStream.Destroy;
begin ClearBuffer; FreeMem(Buffer,BufferSize); end;

{ TBufferedBitStream }

constructor TBufferedBitStream.Create(S:TStream;Mode:TBitStreamMode;BufSize:Integer);
begin
  if BufSize=0 then BufSize:=1024;
  inherited Create(Mode,BufSize);
  Stream:=S;
end;

procedure TBufferedBitStream.ReadBuffer;
begin Stream.Read(Buffer^,BufferSize) end;

procedure TBufferedBitStream.WriteBuffer(Size:Integer);
begin Stream.Write(Buffer^,Size) end;

//--------------- INTEGER SETS ----------------------------------------------

{ TIntegerSet }

procedure TIntegerSet.AssignTo(Dest:TPersistent);
var i:Integer;
begin
  if Dest is TIntegerSet then begin
    TIntegerSet(Dest).BeginUpdate;
    try
      TIntegerSet(Dest).Clear;
      for i:=Min to Max do
        if Member(i) then TIntegerSet(Dest).Include(i);
    finally
      TIntegerSet(Dest).EndUpdate;
    end;
  end
  else inherited AssignTo(Dest);
end;

function TIntegerSet.Empty:Boolean;
begin Result:=Max<Min end;

{ TIntegerMap }

procedure TIntegerMap.Assign(Source:TPersistent);
var i,j,k:Integer;
begin
  if Source is TIntegerMap then begin
    TIntegerMap(Source).Optimize;
    SetLength(A,Length(TIntegerMap(Source).A));
    m1:=TIntegerMap(Source).m1; m2:=TIntegerMap(Source).m2;
    if m1<m2 then Move(TIntegerMap(Source).A[0],A[0],(m2-m1) div 8);
  end
  else if Source is TIntegerSet then begin
    Clear;
    if not TIntegerMap(Source).Empty then begin
      i:=TIntegerMap(Source).Min; Include(i);
      j:=TIntegerMap(Source).Max; Include(j);
      for k:=i+1 to j-1 do
        if TIntegerMap(Source).Member(k) then Include(k);
    end;
  end
  else inherited Assign(Source);
end;

procedure TIntegerMap.SetUpdateState(Updating:Boolean);
begin if not Updating then Optimize end;

procedure TIntegerMap.Optimize;
var i,j:Integer;
begin
  i:=IndexOfFirstOther(A,0); j:=IndexOfLastOther(A,0);
  if i>0 then Move(A[i],A[0],(j-i+1)*SizeOf(Integer));
  SetLength(A,j-i+1);
  Inc(m1,i*INTBSIZE); m2:=m1+Length(A)*INTBSIZE;
end;

procedure TIntegerMap.Clear;
begin SetLength(A,0); m1:=0; m2:=0; end;

function TIntegerMap.Empty:Boolean;
begin
  Result:=OnlyInts(A,0);
  if Result then Clear;
end;

function TIntegerMap.Count:Integer;
var i:Integer;
begin
  Result:=0;
  for i:=0 to High(A) do Inc(Result,BitCount(A[i]));
end;

function TIntegerMap.Min:Integer;
var i:Integer;
begin
  i:=IndexOfFirstOther(A,0);
  if i<0 then begin
    Result:=0; Clear;
  end
  else Result:=i*INTBSIZE+m1+BitScanLS(A[i]);
end;

function TIntegerMap.Max:Integer;
var i:Integer;
begin
  i:=IndexOfLastOther(A,0);
  if i<0 then begin
    Result:=-1; Clear;
  end
  else Result:=i*INTBSIZE+m1+BitScanMS(A[i]);
end;

function TIntegerMap.Member(i:Integer):Boolean;
begin
  if (i<m1) or (i>=m2) then Result:=False
  else Result:=A[(i-m1) div INTBSIZE] shr ((i-m1) mod INTBSIZE) and 1<>0;
end;

procedure TIntegerMap.Include(i:Integer);
const DELTA:array[Boolean] of Integer=(INTBSIZE,8*INTBSIZE);
var m:Integer;
begin
  if m1=m2 then begin
    SetLength(A,1); A[0]:=0;
    m1:=BoundDown2pow(i,DELTA[UpdateCount>0]);
    m2:=BoundUp2pow(i+1,DELTA[UpdateCount>0]);
  end
  else if i<m1 then begin
    m:=BoundDown2pow(i,DELTA[UpdateCount>0]);
    SetLength(A,(m2-m) div INTBSIZE);
    Move(A[0],A[(m1-m) div INTBSIZE],(m2-m1) div 8);
    FillChar(A[0],(m1-m) div 8,0); m1:=m;
  end
  else if i>=m2 then begin
    m:=BoundUp2pow(i+1,DELTA[UpdateCount>0]);
    SetLength(A,(m-m1) div INTBSIZE);
    FillChar(A[(m2-m1) div INTBSIZE],(m-m2) div 8,0); m2:=m;
  end;
  Dec(i,m1);
  A[i div INTBSIZE]:=A[i div INTBSIZE] or 1 shl (i mod INTBSIZE);
end;

procedure TIntegerMap.Exclude(i:Integer);
begin
  if (i>=m1) and (i<m2) then begin
    A[i div INTBSIZE]:=A[i div INTBSIZE] and not (1 shl (i mod INTBSIZE));
    if ((A[0]=0) or (A[High(A)]=0)) and (UpdateCount=0) then Optimize;
  end;
end;

{ TIntegerList }

constructor TIntegerList.Create(Mode:TListMode);
begin inherited Create; M:=Mode; end;

procedure TIntegerList.Assign(Source:TPersistent);
begin
  {_}
  inherited Assign(Source);
end;

procedure TIntegerList.AssignTo(Dest:TPersistent);
begin
  {_}
  inherited AssignTo(Dest);
end;

procedure TIntegerList.SetUpdateState(Updating:Boolean);
begin
  if not Updating and (lmSorted in M) and not IsSorted then Sort;
end;

procedure TIntegerList.SetMode(Mode:TListMode);
var i,j:Integer; B:IntegerArray;
begin
  if (lmMulti in (M-Mode)) or (lmSorted in (Mode-M)) and (UpdateCount=0) then Sort;
  if (lmMulti in (M-Mode)) and (Length(A)>0) then begin
    SetLength(B,Length(A)); B[0]:=A[0]; j:=1;
    for i:=1 to High(A) do
      if A[i]<>A[i-1] then begin
        B[j]:=A[i]; Inc(j);
      end;
    A:=B;
  end;
  M:=Mode;
end;

function TIntegerList.RecIndexFor(i,l,r:Integer):Integer;
var m:Integer;
begin
  if l+1=r then Result:=l
  else begin
    m:=(l+r) div 2;
    if i<=A[m-1] then Result:=RecIndexFor(i,l,m)
    else Result:=RecIndexFor(i,m,r);
  end;
end;

function TIntegerList.IndexFor(i:Integer):Integer;
begin
  if (Length(A)=0) or (i>A[High(A)]) then Result:=Length(A)
  else Result:=RecIndexFor(i,0,Length(A));
end;

procedure TIntegerList.Clear;
begin SetLength(A,0); IsSorted:=True; end;

function TIntegerList.Empty:Boolean;
begin Result:=Length(A)=0 end;

function TIntegerList.Count:Integer;
begin Result:=Length(A) end;

function TIntegerList.Min:Integer;
var i:Integer;
begin
  if Length(A)=0 then Result:=0
  else if IsSorted then Result:=A[0]
  else begin
    Result:=A[0];
    for i:=1 to High(A) do
      if A[i]<Result then Result:=A[i];
  end;
end;

function TIntegerList.Max:Integer;
var i:Integer;
begin
  if Length(A)=0 then Result:=-1
  else if IsSorted then Result:=A[High(A)]
  else begin
    Result:=A[0];
    for i:=1 to High(A) do
      if A[i]>Result then Result:=A[i];
  end;
end;

function TIntegerList.Member(i:Integer):Boolean;
var j:Integer;
begin
  if IsSorted and (Length(A)>8) then begin
    j:=IndexFor(i); Result:=(j<Length(A)) and (A[j]=i);
  end
  else Result:=IndexOfFirst(A,i)>=0;
end;

procedure TIntegerList.Include(i:Integer);
var j:Integer;
begin
  if (lmSorted in M) and (UpdateCount=0) then begin
    j:=IndexFor(i);
    if (lmMulti in M) or ((j<Length(A)) and (A[j]<>i)) then begin
      SetLength(A,Length(A)+1);
      if j<High(A) then Move(A[j],A[j+1],(High(A)-j)*SizeOf(Integer));
      A[j]:=i;
    end;
  end
  else if (lmMulti in M) or (IndexOfFirst(A,i)<0) then begin
    SetLength(A,Length(A)+1); A[High(A)]:=i; IsSorted:=False;
  end;
end;

procedure TIntegerList.Exclude(i:Integer);
var j:Integer;
begin
  if IsSorted then begin
    j:=IndexFor(i);
    if (j=Length(A)) or (A[j]<>i) then Exit;
  end
  else begin
    j:=IndexOfFirst(A,i);
    if j<0 then Exit;
  end;
  if j<High(A) then
    if (lmSorted in M) and (UpdateCount=0) then
      Move(A[j+1],A[j],(High(A)-j)*SizeOf(Integer))
    else begin
      A[j]:=A[High(A)]; IsSorted:=False;
    end;
  SetLength(A,Length(A)-1);
end;

function TIntegerList.CountItem(i:Integer):Integer;
var f,l,j:Integer;
begin
  if lmMulti in M then begin
    f:=IndexOfFirst(A,i);
    if f>=0 then begin
      l:=IndexOfLast(A,i);
      if IsSorted then Result:=l-f+1
      else begin
        Result:=1;
        for j:=f+1 to l do
          if A[j]=i then Inc(Result);
      end;
    end
    else Result:=0;
  end
  else Result:=Ord(Member(i));
end;

procedure TIntegerList.Sort;
  procedure SortBlock(l,r:Integer);
  var i,j,p,x:Integer;
  begin
    i:=l; j:=r; p:=A[(l+r) div 2];
    repeat
      while A[i]<p do Inc(i);
      while A[j]>p do Dec(j);
      if i<=j then begin
        x:=A[i]; A[i]:=A[j]; A[j]:=x; Inc(i); Dec(j);
      end;
    until i>j;
    if l<j then SortBlock(l,j);
    if i<r then SortBlock(i,r);
  end;
begin
  if IsSorted then Exit;
  if Length(A)>1 then SortBlock(0,High(A));
  IsSorted:=True;
end;

{ TiIntervals }

(*
procedure TiIntervals.Assign(Source:TPersistent);
var i,j,m:Integer;
begin
  if Source is TiIntervals then begin
    SetLength(A,Length(TiIntervals(Source).A));
    if Length(A)<>0 then
      Move(TiIntervals(Source).A[0],A[0],Length(A)*SizeOf(TiInterval));
  end
  else if Source is TIntegerSet then begin
    Clear;
    if not TIntegerSet(Source).Empty then begin
      i:=TIntegerSet(Source).Min; j:=i-1;
      m:=TIntegerSet(Source).Max;
      repeat
        repeat Inc(j) until TIntegerSet(Source).Member(j);
        i:=j; repeat Inc(j) until not TIntegerSet(Source).Member(j);
        SetLength(A,Length(A)+1);
        with A[High(A)] do begin
          l:=i; r:=j;
        end;
      until j>m;
    end;
  end
  else inherited Assign(Source);
end;

procedure TiIntervals.AssignTo(Dest:TPersistent);
var i,j:Integer;
begin
  if Dest is TIntegerSet then begin
    TIntegerSet(Dest).Clear;
    for i:=0 to High(A) do
      for j:=A[i].l to A[i].r-1 do TIntegerSet(Dest).Include(j);
  end
  else inherited AssignTo(Dest);
end;

function TiIntervals.RecIndexFor(i,l,r:Integer):Integer;
var m:Integer;
begin
  if l+1=r then Result:=l
  else begin
    m:=(l+r) div 2;
    if i<A[m].l then Result:=RecIndexFor(i,l,m)
    else Result:=RecIndexFor(i,m,r);
  end;
end;

function TiIntervals.IndexFor(i:Integer):Integer;
begin
  if (Length(A)=0) or (i<A[0].l) then Result:=-1
  else Result:=RecIndexFor(i,0,Length(A));
end;

procedure TiIntervals.Clear;
begin SetLength(A,0) end;

function TiIntervals.Empty:Boolean;
begin Result:=Length(A)=0 end;

function TiIntervals.Count:Integer;
var i:Integer;
begin
  Result:=0;
  for i:=0 to High(A) do Inc(Result,A[i].r-A[i].l);
end;

function TiIntervals.Min:Integer;
begin
  if Length(A)=0 then Result:=0
  else Result:=A[0].l;
end;

function TiIntervals.Max:Integer;
begin
  if Length(A)=0 then Result:=0
  else Result:=A[High(A)].r-1;
end;

function TiIntervals.Member(i:Integer):Boolean;
var j:Integer;
begin
  j:=IndexFor(i);
  Result:=(j>=0) and (i<A[j].r);
end;

procedure TiIntervals.Include(i:Integer);
begin IncludeInterval(i,i+1) end;

procedure TiIntervals.Exclude(i:Integer);
begin ExcludeInterval(i,i+1) end;

procedure TiIntervals.IncludeInterval(l,r:Integer);
begin
  {_}
end;

procedure TiIntervals.ExcludeInterval(l,r:Integer);
begin
  {_}
end;
*)

//--------------- LEXICOGRAPHIC TREES ---------------------------------------

const
  LexStrings_ListIndexError='Index out of range for TLexStrings object';
  LexStrings_SortedListError='Can''t affect position in TLexStrings object';

{ TLexTree }

constructor TLexTree.Create;
// Virtual constructor must exist for correct functionality
//  when constructing subtrees of descendant classes.
begin end;

function TLexTree.BlockSize:Integer;
var i:Integer;
begin
  Result:=0;
  for i:=0 to High(A) do Inc(Result,A[i].Len+1);
end;

procedure TLexTree.Change(i,l:Integer);
var m,j,ol:Integer;
begin
  m:=BlockSize; ol:=A[i].Len;
  if l>ol then begin // insert
    ReallocMem(K,m-ol+l); A[0].S:=K; A[i].Len:=l;
    for j:=1 to High(A) do A[j].S:=A[j-1].S+A[j-1].Len+1;
    if i<High(A) then StrMove(A[i].S+l+1,A[i].S+ol+1,m-(A[i].S+ol+1-K));
  end
  else if l<ol then begin // delete
    if i<High(A) then StrMove(A[i].S+l+1,A[i+1].S,m-(A[i+1].S-K));
    ReallocMem(K,m-ol+l); A[0].S:=K; A[i].Len:=l;
    for j:=1 to High(A) do A[j].S:=A[j-1].S+A[j-1].Len+1;
  end;
end;

procedure TLexTree.Insert(i:Integer;const S:PChar);
var m,j:Integer;
begin
  m:=BlockSize; SetLength(A,Length(A)+1);
  if i<High(A) then Move(A[i],A[i+1],(High(A)-i)*SizeOf(TLexTree_field));
  A[i].Len:=StrLen(S);
  ReallocMem(K,m+A[i].Len+1); A[0].S:=K;
  for j:=1 to High(A) do A[j].S:=A[j-1].S+A[j-1].Len+1;
  if i<High(A) then StrMove(A[i+1].S,A[i].S,m-(A[i].S-K));
end;

procedure TLexTree.Remove(i:Integer);
var m,j:Integer;
begin
  m:=BlockSize;
  if i<High(A) then StrMove(A[i].S,A[i+1].S,m-(A[i+1].S-K));
  ReallocMem(K,m-A[i].Len-1); A[0].S:=K;
  if i<High(A) then Move(A[i+1],A[i],(High(A)-i)*SizeOf(TLexTree_field));
  SetLength(A,High(A));
  for j:=1 to High(A) do A[j].S:=A[j-1].S+A[j-1].Len+1;
end;

function TLexTree.StringPos(const S:PChar):Integer;
  function RecStringPos(i,j:Integer):Integer;
  var m:Integer;
  begin
    if j-i<5 then begin
      while (i<j) and (S^>A[i].S^) do Inc(i);
      Result:=i;
    end
    else begin
      m:=(i+j) div 2;
      if S^<A[m].S^ then Result:=RecStringPos(i,m)
      else Result:=RecStringPos(m,j);
    end;
  end;
begin
  if Length(A)=0 then Result:=0
  else Result:=RecStringPos(0,Length(A));
end;

function TLexTree.StringIndex(const S:PChar):Integer;
begin
  if S^=#0 then Result:=-1
  else begin
    Result:=StringPos(S);
    if (Result=Length(A)) or
       (StrLComp(S,A[Result].S,A[Result].Len)<>0) then Result:=-1;
  end;
end;

procedure TLexTree.Clear;
var i:Integer;
begin
  for i:=0 to High(A) do A[i].Tree.Free;
  SetLength(A,0); FreeMem(K);
end;

function TLexTree.Add(const S:PChar):Integer;
var i,j:Integer; x:TLexTree;
begin
  if S^=#0 then Inc(C)
  else begin
    i:=StringPos(S);
    if (i>=Length(A)) or (A[i].S^<>S^) then begin
      Insert(i,S); A[i].Tree:=TLexTree_class(ClassType).Create;
      A[i].Tree.Add('');
    end
    else begin
      j:=CommonPrefixLength(S,A[i].S);
      if j<A[i].Len then begin
        x:=TLexTree_class(ClassType).Create;
        x.Insert(0,A[i].S+j);
        x.A[0].Tree:=A[i].Tree; A[i].Tree:=x;
        Change(i,j); (A[i].S+j)^:=#0;
      end;
      A[i].Tree.Add(S+j);
    end;
  end;
  Result:=0;
end;

function TLexTree.Delete(const S:PChar):Boolean;
var i:Integer; x:TLexTree;
begin
  if S^=#0 then begin
    Result:=C>0; if C>0 then Dec(C);
  end
  else begin
    i:=StringIndex(S);
    if i>=0 then begin
      x:=A[i].Tree; Result:=x.Delete(S+A[i].Len);
      if x.C=0 then
        if Length(x.A)=0 then begin
          x.Free; Remove(i);
        end
        else if Length(x.A)=1 then begin
          Change(i,A[i].Len+x.A[0].Len);
          StrCat(A[i].S,x.A[0].S); x.Free;
        end;
    end
    else Result:=False;
  end;
end;

function TLexTree.Count(const S:PChar):Integer;
var i:Integer;
begin
  if S^=#0 then Result:=C
  else begin
    i:=StringIndex(S);
    if i>=0 then Result:=A[i].Tree.Count(S+A[i].Len)
    else Result:=0;
  end;
end;

function TLexTree.Traverse(OnProcess:TLexProcessFunc;mode,i:Integer):Integer;
var j:Integer;
begin
  if mode and tmPreorder<>0 then i:=OnProcess(Self,mode,i);
  for j:=0 to High(A) do begin
    if (mode and tmInorder<>0) and (j<>0) then i:=OnProcess(Self,mode,i);
    i:=A[j].Tree.Traverse(OnProcess,mode,i);
  end;
  if mode and tmPostorder<>0 then i:=OnProcess(Self,mode,i);
  Result:=i;
end;

destructor TLexTree.Destroy;
begin Clear end;

{ TTaggedLexTree }

function TaggedLexTree_Set(L:TLexTree;mode,i:Integer):Integer;
begin
  if (L.C>0) and (mode and tmExisting<>0) or
     (L.C<=0) and (mode and tmMissing<>0) then TTaggedLexTree(L).T:=i;
  Result:=i;
end;

function TaggedLexTree_Index(L:TLexTree;mode,i:Integer):Integer;
begin
  if (L.C>0) and (mode and tmExisting<>0) or
     (L.C<=0) and (mode and tmMissing<>0) then begin
    TTaggedLexTree(L).T:=i; Inc(i);
  end;
  Result:=i;
end;

function TTaggedLexTree.Tag(const S:PChar):Integer;
var i:Integer;
begin
  if S^=#0 then Result:=T
  else begin
    i:=StringIndex(S);
    if i>=0 then Result:=TTaggedLexTree(A[i].Tree).Tag(S+A[i].Len)
    else Result:=0;
  end;
end;

function TTaggedLexTree.CountTag(tg:Integer):Integer;
var i:Integer;
begin
  Result:=Ord(T=tg);
  for i:=0 to High(A) do Inc(Result,TTaggedLexTree(A[i].Tree).CountTag(tg));
end;

function TTaggedLexTree.CountType(tt:Integer):Integer;
var i:Integer;
begin
  if T<0 then Result:=Ord(tt and vtNegative<>0)
  else if T=0 then Result:=Ord(tt and vtZero<>0)
  else Result:=Ord(tt and vtPositive<>0);
  for i:=0 to High(A) do Inc(Result,TTaggedLexTree(A[i].Tree).CountType(t));
end;

{ TLexStringsTree }

function TLexStringsTree.IndexOf(const S:PChar):Integer;
var i:Integer;
begin
  if S^=#0 then Result:=T
  else begin
    i:=StringIndex(S);
    if i>=0 then Result:=T+TLexStringsTree(A[i].Tree).IndexOf(S+A[i].Len)
    else Result:=-1;
  end;
end;

procedure TLexStringsTree.Get(i,d:Integer;var S:string);
var l,j:Integer;
begin
  l:=Length(A); Dec(i,T); j:=0;
  while (j<l) and (TLexStringsTree(A[j].Tree).T<=i) do Inc(j);
  if j=0 then begin
    SetLength(S,d); S[1+d]:=#0;
  end
  else begin
    Dec(j); TLexStringsTree(A[j].Tree).Get(i,d+A[j].Len,S);
    StrMove(@S[1+d],A[j].S,A[j].Len);
  end;
end;

function TLexStringsTree.Add(const S:PChar):Integer;
var i,j:Integer; x:TLexTree;
begin
  if S^=#0 then Inc(C)
  else begin
    i:=StringPos(S);
    if (i>=Length(A)) or (A[i].S^<>S^) then begin
      Insert(i,S); A[i].Tree:=TLexTree_class(ClassType).Create;
      A[i].Tree.Add('');
      for j:=i+1 to High(A) do Inc(TLexStringsTree(A[j].Tree).T);
    end
    else begin
      j:=CommonPrefixLength(S,A[i].S);
      if j<A[i].Len then begin
        x:=TLexTree_class(ClassType).Create;
        x.Insert(0,A[i].S+j);
        x.A[0].Tree:=A[i].Tree; A[i].Tree:=x;
        Change(i,j); (A[i].S+j)^:=#0;
      end;
      A[i].Tree.Add(S+j);
      for j:=i+1 to High(A) do Inc(TLexStringsTree(A[j].Tree).T);
    end;
  end;
  Result:=0;
end;

function TLexStringsTree.Delete(const S:PChar):Boolean;
var i,j:Integer; x:TLexTree;
begin
  if S^=#0 then begin
    Result:=C>0; if C>0 then Dec(C);
  end
  else begin
    i:=StringIndex(S);
    if i>=0 then begin
      x:=A[i].Tree;
      Result:=x.Delete(S+A[i].Len);
      for j:=i+1 to High(A) do Dec(TLexStringsTree(A[j].Tree).T);
      if x.C=0 then
        if Length(x.A)=0 then begin
          x.Free; Remove(i);
        end
        else if Length(x.A)=1 then begin
          Change(i,A[i].Len+x.A[0].Len);
          StrCat(A[i].S,x.A[0].S); x.Free;
        end;
    end
    else Result:=False;
  end;
end;

{ TLexStrings }

constructor TLexStrings.Create;
begin inherited; L:=TLexStringsTree.Create; FCount:=0; end;

function TLexStrings.GetCount:Integer;
begin Result:=FCount end;

function TLexStrings.Get(Index:Integer):string;
begin
  if (Index<0) or (Index>=FCount) then
    raise EStringListError.Create(LexStrings_ListIndexError);
  L.Get(Index,0,Result);
end;

procedure TLexStrings.Put(Index:Integer;const S:string);
begin raise EStringListError.Create(LexStrings_SortedListError) end;

procedure TLexStrings.Clear;
begin L.Clear; FCount:=0; end;

function TLexStrings.Add(const S:string):Integer;
begin Result:=L.Add(PChar(S)); Inc(FCount); end;

procedure TLexStrings.Delete(Index:Integer);
begin if L.Delete(PChar(Get(Index))) then Dec(FCount) end;

function TLexStrings.IndexOf(const S:string):Integer;
begin Result:=L.IndexOf(PChar(S)) end;

procedure TLexStrings.Insert(Index:Integer;const S:string);
begin raise EStringListError.Create(LexStrings_SortedListError) end;

procedure TLexStrings.Exchange(Index1, Index2: Integer);
begin raise EStringListError.Create(LexStrings_SortedListError) end;

destructor TLexStrings.Destroy;
begin L.Free; inherited; end;

//--------------- SPECIAL CLASSES -------------------------------------------

{ TChangingObject }

procedure TChangingObject.SetUpdateState(Updating:Boolean);
begin end;

procedure TChangingObject.BeginUpdate;
begin Inc(U); if U=1 then SetUpdateState(True); end;

procedure TChangingObject.EndUpdate;
begin if U=1 then SetUpdateState(False); Dec(U); end;

{ TPriorityQueue }

constructor TPriorityQueue.Create(cmp:TDichCompareFunc;owns:Boolean);
begin inherited Create; Compare:=cmp; OwnsObjects:=owns; end;

procedure TPriorityQueue.Exchange(i,j:Integer);
var o:TObject;
begin o:=A[i]; A[i]:=A[j]; A[j]:=o; end;

procedure TPriorityQueue.HeapifyTop;
var i,s:Integer;
begin
  i:=0;
  repeat
    s:=0;
    if (2*i+1<Size) and Compare(A[2*i+1],A[i]) then s:=2*i+1;
    if (2*i+2<Size) and Compare(A[2*i+2],A[i]) and
       ((s=0) or Compare(A[2*i+2],A[s])) then s:=2*i+2;
    if s<>0 then Exchange(i,s);
    i:=s;
  until i=0;
end;

procedure TPriorityQueue.HeapifyBottom;
var i:Integer;
begin
  i:=Size-1;
  while (i>0) and Compare(A[i],A[(i-1) div 2]) do begin
    Exchange(i,(i-1) div 2); i:=(i-1) div 2;
  end;
end;

procedure TPriorityQueue.SetUpdateState(Updating:Boolean);
begin if not Updating then SetLength(A,BoundUp(Size,PriorityQueue_DELTA)) end;

procedure TPriorityQueue.Clear;
var i:Integer;
begin
  if OwnsObjects then
    for i:=0 to Size-1 do A[i].Free;
  z:=0; if UpdateCount=0 then SetLength(A,0);
end;

procedure TPriorityQueue.Push(o:TObject);
const DELTA:array[Boolean] of Integer=(PriorityQueue_DELTA,16);
begin
  if z=Length(A) then
    SetLength(A,z+DELTA[UpdateCount>0]);
  A[z]:=o; Inc(z); HeapifyBottom;
end;

function TPriorityQueue.Pop:TObject;
begin
  if z=0 then raise Exception.Create('No more items in priority queue');
  Result:=A[0]; Dec(z); A[0]:=A[z]; HeapifyTop;
  if (UpdateCount=0) and (z mod PriorityQueue_DELTA=0) then SetLength(A,z);
end;

destructor TPriorityQueue.Destroy;
var i:Integer;
begin
  if OwnsObjects then for i:=0 to Size-1 do A[i].Free;
  inherited Destroy;
end;

//--------------- SYNCHRONIZATION -------------------------------------------

procedure InitSemaphore(var S:TSemaphore;Init,Max:Integer);
// input: eax=@S, edx=[Init], ecx=[Max]
asm
  mov  [eax],edx
  mov  [eax+4],ecx
  xor  edx,edx
  mov  [eax+8],edx
  mov  [eax+12],edx
end;

procedure SemaphoreDown(var S:TSemaphore);
{ Waits until S.Value gets into 1..(S.MaxValue), then decreases S.Value.
  The function works correctly even if interrupted by another thread. }
// input: eax=@S
asm
  mov  ecx,[eax+4] // S.Max
  mov  edx,-1
@wait:
  cmp  dword ptr [eax],0
  jng  @wait
  lock xadd [eax],edx
  or   edx,edx
  jng  @missed
  cmp  edx,ecx
  jng  @go
@missed:
  inc  dword ptr [eax]
  mov  edx,-1
  jmp  @wait
@go:
  inc  dword ptr [eax+8] // S.Lowered
end;

procedure SemaphoreUp(var S:TSemaphore);
{ Waits until S.Value gets into 0..(S.MaxValue-1), then increases S.Value.
  The function works correctly even if interrupted by another thread. }
// input: eax=@S
asm
  mov  ecx,[eax+4] // S.Max
  mov  edx,1
@wait:
  cmp  [eax],ecx
  jnl  @wait
  lock xadd [eax],edx
  or   edx,edx
  jl   @missed
  cmp  edx,ecx
  jl   @go
@missed:
  dec  dword ptr [eax]
  mov  edx,1
  jmp  @wait
@go:
  inc  dword ptr [eax+12] // S.Raised
end;

function IncSharedInt(var I:Integer;By:Integer):Integer;
{ Adds the integer to the variable and returns the new value. Thread-safe.
  The function works correctly even if interrupted by another thread. }
// input: eax=@I, edx=[By]
asm
  mov  ecx,edx
  lock xadd [eax],edx
  xchg eax,edx
  add  eax,ecx
end;

END.
