freepascal.compiler/packages/regexpr/src/regexpr.pas

unit regexpr;

{
  TRegExpr class library
  Delphi Regular Expressions

  Copyright (c) 1999-2004 Andrey V. Sorokin, St.Petersburg, Russia

  You can choose to use this Pascal unit in one of the two following licenses:

  Option 1>

  You may use this software in any kind of development,
  including comercial, redistribute, and modify it freely,
  under the following restrictions :
  1. This software is provided as it is, without any kind of
  warranty given. Use it at Your own risk.The author is not
  responsible for any consequences of use of this software.
  2. The origin of this software may not be mispresented, You
  must not claim that You wrote the original software. If
  You use this software in any kind of product, it would be
  appreciated that there in a information box, or in the
  documentation would be an acknowledgement like

  Partial Copyright (c) 2004 Andrey V. Sorokin
  https://sorokin.engineer/
  [email protected]

  3. You may not have any income from distributing this source
  (or altered version of it) to other developers. When You
  use this product in a comercial package, the source may
  not be charged seperatly.
  4. Altered versions must be plainly marked as such, and must
  not be misrepresented as being the original software.
  5. RegExp Studio application and all the visual components as
  well as documentation is not part of the TRegExpr library
  and is not free for usage.

  https://sorokin.engineer/
  [email protected]

  Option 2>

  The same modified LGPL with static linking exception as the Free Pascal RTL
}

{
program is essentially a linear encoding
of a nondeterministic finite-state machine (aka syntax charts or
"railroad normal form" in parsing technology). Each node is an opcode
plus a "next" pointer, possibly plus an operand. "Next" pointers of
all nodes except BRANCH implement concatenation; a "next" pointer with
a BRANCH on both ends of it connects two alternatives. (Here we
have one of the subtle syntax dependencies: an individual BRANCH (as
opposed to a collection of them) is never concatenated with anything
because of operator precedence.) The operand of some types of node is
a literal string; for others, it is a node leading into a sub-FSM. In
particular, the operand of a BRANCH node is the first node of the branch.
(NB this is *not* a tree structure: the tail of the branch connects
to the thing following the set of BRANCHes.)
}

interface

{ off $DEFINE DebugSynRegExpr }
// ======== Determine compiler

// ======== Define base compiler options
{$BOOLEVAL OFF}
{$EXTENDEDSYNTAX ON}
{$LONGSTRINGS ON}
{$MODE DELPHI} // Delphi-compatible mode in FreePascal
{$INLINE ON}
{$DEFINE COMPAT}
// ======== Define options for TRegExpr engine
{ off $DEFINE UnicodeRE} // Use WideChar for characters and UnicodeString/WideString for strings
{ off $DEFINE UnicodeEx} // Support Unicode >0xFFFF, e.g. emoji, e.g. "." must find 2 WideChars of 1 emoji
{$DEFINE UseWordChars} // Use WordChars property, otherwise fixed list 'a'..'z','A'..'Z','0'..'9','_'
{$DEFINE UseSpaceChars} // Use SpaceChars property, otherwise fixed list
{$DEFINE UseLineSep} // Use LineSeparators property, otherwise fixed line-break chars
{ off $DEFINE FastUnicodeData} // Use arrays for UpperCase/LowerCase/IsWordChar, they take 320K more memory
{$DEFINE UseFirstCharSet} // Enable optimization, which finds possible first chars of input string
{$DEFINE RegExpPCodeDump} // Enable method Dump() to show opcode as string
{$IFNDEF FPC} // Not supported in FreePascal
  {$DEFINE reRealExceptionAddr} // Exceptions will point to appropriate source line, not to Error procedure
{$ENDIF}
{$DEFINE ComplexBraces} // Support braces in complex cases
{$IFNDEF UnicodeRE}
  {$UNDEF UnicodeEx}
  {$UNDEF FastUnicodeData}
{$ENDIF}
{.$DEFINE Compat} // Enable compatability methods/properties for forked version in Free Pascal 3.0
// ======== Define Pascal-language options
// Define 'UseAsserts' option (do not edit this definitions).
// Asserts used to catch 'strange bugs' in TRegExpr implementation (when something goes
// completely wrong). You can swith asserts on/off with help of {$C+}/{$C-} compiler options.
{$IFDEF D3} {$DEFINE UseAsserts} {$ENDIF}
{$IFDEF FPC} {$DEFINE UseAsserts} {$ENDIF}
// Define 'use subroutine parameters default values' option (do not edit this definition).
{$IFDEF D4} {$DEFINE DefParam} {$ENDIF}
{$IFDEF FPC} {$DEFINE DefParam} {$ENDIF}
// Define 'OverMeth' options, to use method overloading (do not edit this definitions).
{$IFDEF D5} {$DEFINE OverMeth} {$ENDIF}
{$IFDEF FPC} {$DEFINE OverMeth} {$ENDIF}
// Define 'InlineFuncs' options, to use inline keyword (do not edit this definitions).
{$IFDEF D8} {$DEFINE InlineFuncs} {$ENDIF}
{$IFDEF FPC} {$DEFINE InlineFuncs} {$ENDIF}

uses
  SysUtils, // Exception
  {$IFDEF D2009}
    {$IFDEF D_XE2}
    System.Character,
    {$ELSE}
    Character,
    {$ENDIF}
  {$ENDIF}
  Classes; // TStrings in Split method

type
  {$IFNDEF FPC}
  // Delphi doesn't have PtrInt but has NativeInt
  // but unfortunately NativeInt is declared wrongly in several versions
    {$IF SizeOf(Pointer)=4}
    PtrInt = Integer;
    PtrUInt = Cardinal;
    {$ELSE}
    PtrInt = Int64;
    PtrUInt = UInt64;
    {$IFEND}
  {$ENDIF}

  {$IFDEF UnicodeRE}
  PRegExprChar = PWideChar;
  {$IFDEF FPC}
  RegExprString = UnicodeString;
  {$ELSE}
    {$IFDEF D2009}
    RegExprString = UnicodeString;
    {$ELSE}
    RegExprString = WideString;
    {$ENDIF}
  {$ENDIF}
  REChar = WideChar;
  {$ELSE}
  PRegExprChar = PAnsiChar;
  RegExprString = AnsiString;
  REChar = AnsiChar;
  {$ENDIF}
  TREOp = REChar; // internal opcode type
  PREOp = ^TREOp;

type
  TRegExprCharset = set of byte;

const
  // Escape AnsiChar ('\' in common r.e.) used for escaping metachars (\w, \d etc)
  EscChar = '\';

  // Substitute method: prefix of group reference: $1 .. $9 and $<name>
  SubstituteGroupChar = '$';

  RegExprModifierI: boolean = False; // default value for ModifierI
  RegExprModifierR: boolean = True; // default value for ModifierR
  RegExprModifierS: boolean = True; // default value for ModifierS
  RegExprModifierG: boolean = True; // default value for ModifierG
  RegExprModifierM: boolean = False; // default value for ModifierM
  RegExprModifierX: boolean = False; // default value for ModifierX

  {$IFDEF UseSpaceChars}
  // default value for SpaceChars
  RegExprSpaceChars: RegExprString = ' '#$9#$A#$D#$C;
  {$ENDIF}

  {$IFDEF UseWordChars}
  // default value for WordChars
  RegExprWordChars: RegExprString = '0123456789'
    + 'abcdefghijklmnopqrstuvwxyz'
    + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_';
  {$ENDIF}

  {$IFDEF UseLineSep}
  // default value for LineSeparators
  RegExprLineSeparators: RegExprString = #$d#$a#$b#$c
    {$IFDEF UnicodeRE}
    + #$2028#$2029#$85
    {$ENDIF};
  {$ENDIF}

  // Tab and Unicode category "Space Separator":
  // https://www.compart.com/en/unicode/category/Zs
  RegExprHorzSeparators: RegExprString = #9#$20#$A0
    {$IFDEF UnicodeRE}
    + #$1680#$2000#$2001#$2002#$2003#$2004#$2005#$2006#$2007#$2008#$2009#$200A#$202F#$205F#$3000
    {$ENDIF};

  RegExprUsePairedBreak: boolean = True;
  RegExprReplaceLineBreak: RegExprString = sLineBreak;

  RegExprLookaheadIsAtomic: boolean = False;
  RegExprLookbehindIsAtomic: boolean = True;

const
  // Max number of groups.
  // Be carefull - don't use values which overflow OP_CLOSE* opcode
  // (in this case you'll get compiler error).
  // Big value causes slower work and more stack required.
  RegexMaxGroups = 90;

  // Max possible value for RegexMaxGroups.
  // Don't change it! It's defined by internal TRegExpr design.
  RegexMaxMaxGroups = 255;

  // Max depth of recursion for (?R) and (?1)..(?9)
  RegexMaxRecursion = 20;

{$IFDEF ComplexBraces}
const
  LoopStackMax = 10; // max depth of loops stack //###0.925

type
  TRegExprLoopStack = array [1 .. LoopStackMax] of integer;
{$ENDIF}

type
  TRegExprModifiers = record
    I: boolean;
       // Case-insensitive.
    R: boolean;
       // Extended syntax for Russian ranges in [].
       // If True, then а-я additionally includes letter 'ё',
       // А-Я additionally includes 'Ё', and а-Я includes all Russian letters.
       // Turn it off if it interferes with your national alphabet.
    S: boolean;
       // Dot '.' matches any AnsiChar, otherwise only [^\n].
    G: boolean;
       // Greedy. Switching it off switches all operators to non-greedy style,
       // so if G=False, then '*' works like '*?', '+' works like '+?' and so on.
    M: boolean;
       // Treat string as multiple lines. It changes `^' and `$' from
       // matching at only the very start/end of the string to the start/end
       // of any line anywhere within the string.
    X: boolean;
       // Allow comments in regex using # AnsiChar.
  end;

function IsModifiersEqual(const A, B: TRegExprModifiers): boolean;

type
  TRegExpr = class;
  TRegExprReplaceFunction = function(ARegExpr: TRegExpr): RegExprString of object;
  TRegExprCharChecker = function(ch: REChar): boolean of object;
  TRegExprCharCheckerArray = array[0 .. 30] of TRegExprCharChecker;
  TRegExprCharCheckerInfo = record
    CharBegin, CharEnd: REChar;
    CheckerIndex: integer;
  end;
  TRegExprCharCheckerInfos = array of TRegExprCharCheckerInfo;

  {$IFDEF Compat}
  TRegExprInvertCaseFunction = function(const Ch: REChar): REChar of object;
  {$ENDIF}

  TRegExprBounds = record
    GrpStart: array [0 .. RegexMaxGroups - 1] of PRegExprChar; // pointer to group start in InputString
    GrpEnd: array [0 .. RegexMaxGroups - 1] of PRegExprChar; // pointer to group end in InputString
  end;
  TRegExprBoundsArray = array[0 .. RegexMaxRecursion] of TRegExprBounds;

  { TRegExpr }

  TRegExpr = class
  private
    GrpBounds: TRegExprBoundsArray;
    GrpIndexes: array [0 .. RegexMaxGroups - 1] of integer; // map global group index to _capturing_ group index
    GrpNames: array [0 .. RegexMaxGroups - 1] of RegExprString; // names of groups, if non-empty
    GrpAtomic: array [0 .. RegexMaxGroups - 1] of boolean; // group[i] is atomic (filled in Compile)
    GrpAtomicDone: array [0 .. RegexMaxGroups - 1] of boolean; // atomic group[i] is "done" (used in Exec* only)
    GrpOpCodes: array [0 .. RegexMaxGroups - 1] of PRegExprChar; // pointer to opcode of group[i] (used by OP_SUBCALL*)
    GrpSubCalled: array [0 .. RegexMaxGroups - 1] of boolean; // group[i] is called by OP_SUBCALL*
    GrpCount: integer;

    {$IFDEF ComplexBraces}
    LoopStack: TRegExprLoopStack; // state before entering loop
    LoopStackIdx: integer; // 0 - out of all loops
    {$ENDIF}

    // The "internal use only" fields to pass info from compile
    // to execute that permits the execute phase to run lots faster on
    // simple cases.

    regAnchored: REChar; // is the match anchored (at beginning-of-line only)?
    // regAnchored permits very fast decisions on suitable starting points
    // for a match, cutting down the work a lot. regMust permits fast rejection
    // of lines that cannot possibly match. The regMust tests are costly enough
    // that regcomp() supplies a regMust only if the r.e. contains something
    // potentially expensive (at present, the only such thing detected is * or +
    // at the start of the r.e., which can involve a lot of backup). regMustLen is
    // supplied because the test in regexec() needs it and regcomp() is computing
    // it anyway.

    regMust: PRegExprChar; // string (pointer into program) that match must include, or nil
    regMustLen: integer; // length of regMust string
    regMustString: RegExprString; // string which must occur in match (got from regMust/regMustLen)
    regLookahead: boolean; // regex has _some_ lookahead
    regLookaheadNeg: boolean; // regex has _nagative_ lookahead
    regLookaheadGroup: integer; // index of group for lookahead
    regLookbehind: boolean; // regex has positive lookbehind
    regNestedCalls: integer; // some attempt to prevent 'catastrophic backtracking' but not used

    {$IFDEF UseFirstCharSet}
    FirstCharSet: TRegExprCharset;
    FirstCharArray: array[byte] of boolean;
    {$ENDIF}

    // work variables for Exec routines - save stack in recursion
    regInput: PRegExprChar; // pointer to currently handling AnsiChar of input string
    fInputStart: PRegExprChar; // pointer to first AnsiChar of input string
    fInputEnd: PRegExprChar; // pointer after last AnsiChar of input string
    fRegexStart: PRegExprChar; // pointer to first AnsiChar of regex
    fRegexEnd: PRegExprChar; // pointer after last AnsiChar of regex
    regCurrentGrp: integer; // index of group handling by OP_OPEN* opcode
    regRecursion: integer; // current level of recursion (?R) (?1); always 0 if no recursion is used

    // work variables for compiler's routines
    regParse: PRegExprChar; // pointer to currently handling AnsiChar of regex
    regNumBrackets: integer; // count of () brackets
    regDummy: REChar; // dummy pointer, used to detect 1st/2nd pass of Compile
                      // if p=@regDummy, it is pass-1: opcode memory is not yet allocated
    programm: PRegExprChar; // pointer to opcode, =nil in pass-1
    regCode: PRegExprChar; // pointer to last emitted opcode; changing in pass-2, but =@regDummy in pass-1
    regCodeSize: integer; // total opcode size in REChars
    regCodeWork: PRegExprChar; // pointer to opcode, to first code after MAGIC
    regExactlyLen: PLongInt; // pointer to length of substring of OP_EXACTLY* inside opcode
    fSecondPass: boolean; // true inside pass-2 of Compile

    fExpression: RegExprString; // regex string
    fInputString: RegExprString; // input string
    fLastError: integer; // Error call sets code of LastError
    fLastErrorOpcode: TREOp;
    fLastErrorSymbol: REChar;

    fModifiers: TRegExprModifiers; // regex modifiers
    fCompModifiers: TRegExprModifiers; // compiler's copy of modifiers
    fProgModifiers: TRegExprModifiers; // modifiers values from last programm compilation

    {$IFDEF UseSpaceChars}
    fSpaceChars: RegExprString;
    {$ENDIF}
    {$IFDEF UseWordChars}
    fWordChars: RegExprString;
    {$ENDIF}

    {$IFDEF UseLineSep}
    fLineSeparators: RegExprString;
    {$ENDIF}

    fUsePairedBreak: boolean;
    fReplaceLineEnd: RegExprString; // string to use for "\n" in Substitute method

    fSlowChecksSizeMax: integer;
    // Exec() param ASlowChecks is set to True, when Length(InputString)<SlowChecksSizeMax
    // This ASlowChecks enables to use regMustString optimization

    {$IFDEF UseLineSep}
      {$IFNDEF UnicodeRE}
      fLineSepArray: array[byte] of boolean;
      {$ENDIF}
    {$ENDIF}

    CharCheckers: TRegExprCharCheckerArray;
    CharCheckerInfos: TRegExprCharCheckerInfos;
    CheckerIndex_Word: byte;
    CheckerIndex_NotWord: byte;
    CheckerIndex_Digit: byte;
    CheckerIndex_NotDigit: byte;
    CheckerIndex_Space: byte;
    CheckerIndex_NotSpace: byte;
    CheckerIndex_HorzSep: byte;
    CheckerIndex_NotHorzSep: byte;
    CheckerIndex_VertSep: byte;
    CheckerIndex_NotVertSep: byte;
    CheckerIndex_LowerAZ: byte;
    CheckerIndex_UpperAZ: byte;

    fHelper: TRegExpr;
    fHelperLen: integer;

    {$IFDEF Compat}
    fUseUnicodeWordDetection: boolean;
    fInvertCase: TRegExprInvertCaseFunction;
    fEmptyInputRaisesError: boolean;
    fUseOsLineEndOnReplace: boolean;
    function OldInvertCase(const Ch: REChar): REChar;
    function GetLinePairedSeparator: RegExprString;
    procedure SetLinePairedSeparator(const AValue: RegExprString);
    procedure SetUseOsLineEndOnReplace(AValue: boolean);
    {$ENDIF}

    procedure InitCharCheckers;
    function CharChecker_Word(ch: REChar): boolean;
    function CharChecker_NotWord(ch: REChar): boolean;
    function CharChecker_Space(ch: REChar): boolean;
    function CharChecker_NotSpace(ch: REChar): boolean;
    function CharChecker_Digit(ch: REChar): boolean;
    function CharChecker_NotDigit(ch: REChar): boolean;
    function CharChecker_HorzSep(ch: REChar): boolean;
    function CharChecker_NotHorzSep(ch: REChar): boolean;
    function CharChecker_VertSep(ch: REChar): boolean;
    function CharChecker_NotVertSep(ch: REChar): boolean;
    function CharChecker_LowerAZ(ch: REChar): boolean;
    function CharChecker_UpperAZ(ch: REChar): boolean;
    function DumpCheckerIndex(N: byte): RegExprString;
    function DumpCategoryChars(ch, ch2: REChar; Positive: boolean): RegExprString;

    procedure ClearMatches; {$IFDEF InlineFuncs}inline;{$ENDIF}
    procedure ClearInternalIndexes; {$IFDEF InlineFuncs}inline;{$ENDIF}
    function FindInCharClass(ABuffer: PRegExprChar; AChar: REChar; AIgnoreCase: boolean): boolean;
    procedure GetCharSetFromCharClass(ABuffer: PRegExprChar; AIgnoreCase: boolean; var ARes: TRegExprCharset);
    procedure GetCharSetFromSpaceChars(var ARes: TRegExprCharset); {$IFDEF InlineFuncs}inline;{$ENDIF}
    procedure GetCharSetFromWordChars(var ARes: TRegExprCharSet); {$IFDEF InlineFuncs}inline;{$ENDIF}
    function IsWordChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
    function IsSpaceChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
    function IsCustomLineSeparator(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
    {$IFDEF UseLineSep}
    procedure InitLineSepArray;
    {$ENDIF}
    procedure FindGroupName(APtr, AEndPtr: PRegExprChar; AEndChar: REChar; var AName: RegExprString);

    // Mark programm as having to be [re]compiled
    procedure InvalidateProgramm;

    // Check if we can use compiled regex, compile it if something changed
    function IsProgrammOk: boolean;

    procedure SetExpression(const AStr: RegExprString);

    function GetModifierStr: RegExprString;
    procedure SetModifierStr(const AStr: RegExprString);
    function GetModifierG: boolean;
    function GetModifierI: boolean;
    function GetModifierM: boolean;
    function GetModifierR: boolean;
    function GetModifierS: boolean;
    function GetModifierX: boolean;
    procedure SetModifierG(AValue: boolean);
    procedure SetModifierI(AValue: boolean);
    procedure SetModifierM(AValue: boolean);
    procedure SetModifierR(AValue: boolean);
    procedure SetModifierS(AValue: boolean);
    procedure SetModifierX(AValue: boolean);

    // Default handler raises exception ERegExpr with
    // Message = ErrorMsg (AErrorID), ErrorCode = AErrorID
    // and CompilerErrorPos = value of property CompilerErrorPos.
    procedure Error(AErrorID: integer); virtual; // error handler.

    { ==================== Compiler section =================== }
    // compile a regular expression into internal code
    function CompileRegExpr(ARegExp: PRegExprChar): boolean;

    // set the next-pointer at the end of a node chain
    procedure Tail(p: PRegExprChar; val: PRegExprChar);

    // regoptail - regtail on operand of first argument; nop if operandless
    procedure OpTail(p: PRegExprChar; val: PRegExprChar);

    // regnode - emit a node, return location
    function EmitNode(op: TREOp): PRegExprChar;

    // emit (if appropriate) a byte of code
    procedure EmitC(ch: REChar); {$IFDEF InlineFuncs}inline;{$ENDIF}

    // emit LongInt value
    procedure EmitInt(AValue: LongInt); {$IFDEF InlineFuncs}inline;{$ENDIF}

    // emit back-reference to group
    function EmitGroupRef(AIndex: integer; AIgnoreCase: boolean): PRegExprChar;

    {$IFDEF FastUnicodeData}
    procedure FindCategoryName(var scan: PRegExprChar; var ch1, ch2: REChar);
    function EmitCategoryMain(APositive: boolean): PRegExprChar;
    {$ENDIF}

    // insert an operator in front of already-emitted operand
    // Means relocating the operand.
    procedure InsertOperator(op: TREOp; opnd: PRegExprChar; sz: integer);
    // ###0.90

    // regular expression, i.e. main body or parenthesized thing
    function ParseReg(InBrackets: boolean; var FlagParse: integer): PRegExprChar;

    // one alternative of an | operator
    function ParseBranch(var FlagParse: integer): PRegExprChar;

    // something followed by possible [*+?]
    function ParsePiece(var FlagParse: integer): PRegExprChar;

    function HexDig(Ch: REChar): integer;

    function UnQuoteChar(var APtr, AEnd: PRegExprChar): REChar;

    // the lowest level
    function ParseAtom(var FlagParse: integer): PRegExprChar;

    // current pos in r.e. - for error hanling
    function GetCompilerErrorPos: PtrInt;

    {$IFDEF UseFirstCharSet} // ###0.929
    procedure FillFirstCharSet(prog: PRegExprChar);
    {$ENDIF}
    { ===================== Matching section =================== }
    // repeatedly match something simple, report how many
    function FindRepeated(p: PRegExprChar; AMax: integer): integer;

    // dig the "next" pointer out of a node
    function regNext(p: PRegExprChar): PRegExprChar;

    // recursively matching routine
    function MatchPrim(prog: PRegExprChar): boolean;

    // match at specific position only, called from ExecPrim
    function MatchAtOnePos(APos: PRegExprChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}

    // Exec for stored InputString
    function ExecPrim(AOffset: integer; ATryOnce, ASlowChecks, ABackward: boolean): boolean;

    function GetSubExprCount: integer;
    function GetMatchPos(Idx: integer): PtrInt;
    function GetMatchLen(Idx: integer): PtrInt;
    function GetMatch(Idx: integer): RegExprString;

    procedure SetInputString(const AInputString: RegExprString);
    procedure SetInputRange(AStart, AEnd: PRegExprChar);

    {$IFDEF UseLineSep}
    procedure SetLineSeparators(const AStr: RegExprString);
    {$ENDIF}
    procedure SetUsePairedBreak(AValue: boolean);

  public
    constructor Create; {$IFDEF OverMeth} overload;
    constructor Create(const AExpression: RegExprString); overload;
    {$ENDIF}
    destructor Destroy; override;

    class function VersionMajor: integer;
    class function VersionMinor: integer;

    // match a programm against a string AInputString
    // !!! Exec store AInputString into InputString property
    // For Delphi 5 and higher available overloaded versions - first without
    // parameter (uses already assigned to InputString property value)
    // and second that has int parameter and is same as ExecPos
    function Exec(const AInputString: RegExprString): boolean;
    {$IFDEF OverMeth} overload;
    function Exec: boolean; overload;
    function Exec(AOffset: integer): boolean; overload;
    {$ENDIF}

    // find next match:
    // ExecNext;
    // works the same as
    // if MatchLen [0] = 0 then ExecPos (MatchPos [0] + 1)
    // else ExecPos (MatchPos [0] + MatchLen [0]);
    // but it's more simpler !
    // Raises exception if used without preceeding SUCCESSFUL call to
    // Exec* (Exec, ExecPos, ExecNext). So You always must use something like
    // if Exec (InputString) then repeat { proceed results} until not ExecNext;
    function ExecNext(ABackward: boolean {$IFDEF DefParam} = False{$ENDIF}): boolean;

    // find match for InputString starting from AOffset position
    // (AOffset=1 - first AnsiChar of InputString)
    function ExecPos(AOffset: integer {$IFDEF DefParam} = 1{$ENDIF}): boolean;
    {$IFDEF OverMeth} overload;
    function ExecPos(AOffset: integer; ATryOnce, ABackward: boolean): boolean; overload;
    {$ENDIF}

    // Returns ATemplate with '$&' or '$0' replaced by whole r.e.
    // occurence and '$1'...'$nn' replaced by subexpression with given index.
    // Symbol '$' is used instead of '\' (for future extensions
    // and for more Perl-compatibility) and accepts more than one digit.
    // If you want to place into template raw '$' or '\', use prefix '\'.
    // Example: '1\$ is $2\\rub\\' -> '1$ is <Match[2]>\rub\'
    // If you want to place any number after '$' you must enclose it
    // with curly braces: '${12}'.
    // Example: 'a$12bc' -> 'a<Match[12]>bc'
    // 'a${1}2bc' -> 'a<Match[1]>2bc'.
    function Substitute(const ATemplate: RegExprString): RegExprString;

    // Splits AInputStr to list by positions of all r.e. occurencies.
    // Internally calls Exec, ExecNext.
    procedure Split(const AInputStr: RegExprString; APieces: TStrings);

    function Replace(const AInputStr: RegExprString;
      const AReplaceStr: RegExprString;
      AUseSubstitution: boolean{$IFDEF DefParam} = False{$ENDIF}) // ###0.946
      : RegExprString; {$IFDEF OverMeth} overload;
    function Replace(const AInputStr: RegExprString;
      AReplaceFunc: TRegExprReplaceFunction): RegExprString; overload;
    {$ENDIF}
    // Returns AInputStr with r.e. occurencies replaced by AReplaceStr.
    // If AUseSubstitution is true, then AReplaceStr will be used
    // as template for Substitution methods.
    // For example:
    // Expression := '({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*';
    // Replace ('BLOCK( test1)', 'def "$1" value "$2"', True);
    // will return:  def 'BLOCK' value 'test1'
    // Replace ('BLOCK( test1)', 'def "$1" value "$2"')
    // will return:  def "$1" value "$2"
    // Internally calls Exec, ExecNext.
    // Overloaded version and ReplaceEx operate with callback function,
    // so you can implement really complex functionality.
    function ReplaceEx(const AInputStr: RegExprString;
      AReplaceFunc: TRegExprReplaceFunction): RegExprString;

    {$IFDEF Compat}
    function ExecPos(AOffset: integer; ATryOnce: boolean): boolean; overload; deprecated 'Use modern form of ExecPos()';
    class function InvertCaseFunction(const Ch: REChar): REChar; deprecated 'This has no effect now';
    property InvertCase: TRegExprInvertCaseFunction read fInvertCase write fInvertCase; deprecated 'This has no effect now';
    property UseUnicodeWordDetection: boolean read fUseUnicodeWordDetection write fUseUnicodeWordDetection; deprecated 'This has no effect, use {$DEFINE UnicodeRE} instead';
    property LinePairedSeparator: RegExprString read GetLinePairedSeparator write SetLinePairedSeparator; deprecated 'This has no effect now';
    property EmptyInputRaisesError: boolean read fEmptyInputRaisesError write fEmptyInputRaisesError; deprecated 'This has no effect now';
    property UseOsLineEndOnReplace: boolean read fUseOsLineEndOnReplace write SetUseOsLineEndOnReplace; deprecated 'Use property ReplaceLineEnd instead';
    {$ENDIF}

    // Returns ID of last error, 0 if no errors (unusable if
    // Error method raises exception) and clear internal status
    // into 0 (no errors).
    function LastError: integer;

    // Returns Error message for error with ID = AErrorID.
    function ErrorMsg(AErrorID: integer): RegExprString; virtual;

    // Re-compile regex
    procedure Compile;

    {$IFDEF RegExpPCodeDump}
    // Show compiled regex in textual form
    function Dump: RegExprString;
    // Show single opcode in textual form
    function DumpOp(op: TREOp): RegExprString;
    {$ENDIF}

    function IsCompiled: boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}

    // Opcode contains only operations for fixed match length: EXACTLY*, ANY*, etc
    function IsFixedLength(var op: TREOp; var ALen: integer): boolean;

    // Regular expression.
    // For optimization, TRegExpr will automatically compiles it into 'P-code'
    // (You can see it with help of Dump method) and stores in internal
    // structures. Real [re]compilation occures only when it really needed -
    // while calling Exec, ExecNext, Substitute, Dump, etc
    // and only if Expression or other P-code affected properties was changed
    // after last [re]compilation.
    // If any errors while [re]compilation occures, Error method is called
    // (by default Error raises exception - see below)
    property Expression: RegExprString read fExpression write SetExpression;

    // Set/get default values of r.e.syntax modifiers. Modifiers in
    // r.e. (?ismx-ismx) will replace this default values.
    // If you try to set unsupported modifier, Error will be called
    // (by defaul Error raises exception ERegExpr).
    property ModifierStr: RegExprString read GetModifierStr write SetModifierStr;

    property ModifierI: boolean read GetModifierI write SetModifierI;
    property ModifierR: boolean read GetModifierR write SetModifierR;
    property ModifierS: boolean read GetModifierS write SetModifierS;
    property ModifierG: boolean read GetModifierG write SetModifierG;
    property ModifierM: boolean read GetModifierM write SetModifierM;
    property ModifierX: boolean read GetModifierX write SetModifierX;

    // returns current input string (from last Exec call or last assign
    // to this property).
    // Any assignment to this property clear Match* properties !
    property InputString: RegExprString read fInputString write SetInputString;

    // Number of subexpressions has been found in last Exec* call.
    // If there are no subexpr. but whole expr was found (Exec* returned True),
    // then SubExprMatchCount=0, if no subexpressions nor whole
    // r.e. found (Exec* returned false) then SubExprMatchCount=-1.
    // Note, that some subexpr. may be not found and for such
    // subexpr. MathPos=MatchLen=-1 and Match=''.
    // For example: Expression := '(1)?2(3)?';
    // Exec ('123'): SubExprMatchCount=2, Match[0]='123', [1]='1', [2]='3'
    // Exec ('12'): SubExprMatchCount=1, Match[0]='12', [1]='1'
    // Exec ('23'): SubExprMatchCount=2, Match[0]='23', [1]='', [2]='3'
    // Exec ('2'): SubExprMatchCount=0, Match[0]='2'
    // Exec ('7') - return False: SubExprMatchCount=-1
    property SubExprMatchCount: integer read GetSubExprCount;

    // pos of entrance subexpr. #Idx into tested in last Exec*
    // string. First subexpr. has Idx=1, last - MatchCount,
    // whole r.e. has Idx=0.
    // Returns -1 if in r.e. no such subexpr. or this subexpr.
    // not found in input string.
    property MatchPos[Idx: integer]: PtrInt read GetMatchPos;

    // len of entrance subexpr. #Idx r.e. into tested in last Exec*
    // string. First subexpr. has Idx=1, last - MatchCount,
    // whole r.e. has Idx=0.
    // Returns -1 if in r.e. no such subexpr. or this subexpr.
    // not found in input string.
    // Remember - MatchLen may be 0 (if r.e. match empty string) !
    property MatchLen[Idx: integer]: PtrInt read GetMatchLen;

    // == copy (InputString, MatchPos [Idx], MatchLen [Idx])
    // Returns '' if in r.e. no such subexpr. or this subexpr.
    // not found in input string.
    property Match[Idx: integer]: RegExprString read GetMatch;

    // get index of group (subexpression) by name, to support named groups
    // like in Python: (?P<name>regex)
    function MatchIndexFromName(const AName: RegExprString): integer;

    function MatchFromName(const AName: RegExprString): RegExprString;

    // Returns position in r.e. where compiler stopped.
    // Useful for error diagnostics
    property CompilerErrorPos: PtrInt read GetCompilerErrorPos;

    {$IFDEF UseSpaceChars}
    // Contains chars, treated as /s (initially filled with RegExprSpaceChars
    // global constant)
    property SpaceChars: RegExprString read fSpaceChars write fSpaceChars;
    // ###0.927
    {$ENDIF}

    {$IFDEF UseWordChars}
    // Contains chars, treated as /w (initially filled with RegExprWordChars
    // global constant)
    property WordChars: RegExprString read fWordChars write fWordChars;
    // ###0.929
    {$ENDIF}

    {$IFDEF UseLineSep}
    // line separators (like \n in Unix)
    property LineSeparators: RegExprString read fLineSeparators write SetLineSeparators; // ###0.941
    {$ENDIF}

    // support paired line-break CR LF
    property UseLinePairedBreak: boolean read fUsePairedBreak write SetUsePairedBreak;

    property ReplaceLineEnd: RegExprString read fReplaceLineEnd write fReplaceLineEnd;

    property SlowChecksSizeMax: integer read fSlowChecksSizeMax write fSlowChecksSizeMax;
  end;

type
  ERegExpr = class(Exception)
  public
    ErrorCode: integer;
    CompilerErrorPos: PtrInt;
  end;

  // true if string AInputString match regular expression ARegExpr
  // ! will raise exeption if syntax errors in ARegExpr
function ExecRegExpr(const ARegExpr, AInputStr: RegExprString): boolean;

// Split AInputStr into APieces by r.e. ARegExpr occurencies
procedure SplitRegExpr(const ARegExpr, AInputStr: RegExprString;
  APieces: TStrings);

// Returns AInputStr with r.e. occurencies replaced by AReplaceStr
// If AUseSubstitution is true, then AReplaceStr will be used
// as template for Substitution methods.
// For example:
// ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*',
// 'BLOCK( test1)', 'def "$1" value "$2"', True)
// will return:  def 'BLOCK' value 'test1'
// ReplaceRegExpr ('({-i}block|var)\s*\(\s*([^ ]*)\s*\)\s*',
// 'BLOCK( test1)', 'def "$1" value "$2"')
// will return:  def "$1" value "$2"
function ReplaceRegExpr(const ARegExpr, AInputStr, AReplaceStr: RegExprString;
  AUseSubstitution: boolean{$IFDEF DefParam} = False{$ENDIF}): RegExprString;
{$IFDEF OverMeth}overload; // ###0.947

// Alternate form allowing to set more parameters.

type
  TRegexReplaceOption = (
    rroModifierI,
    rroModifierR,
    rroModifierS,
    rroModifierG,
    rroModifierM,
    rroModifierX,
    rroUseSubstitution,
    rroUseOsLineEnd
    );
  TRegexReplaceOptions = set of TRegexReplaceOption;

function ReplaceRegExpr(const ARegExpr, AInputStr, AReplaceStr: RegExprString;
  Options: TRegexReplaceOptions): RegExprString; overload;
{$ENDIF}
// Replace all metachars with its safe representation,
// for example 'abc$cd.(' converts into 'abc\$cd\.\('
// This function useful for r.e. autogeneration from
// user input
function QuoteRegExprMetaChars(const AStr: RegExprString): RegExprString;
// Makes list of subexpressions found in ARegExpr r.e.
// In ASubExps every item represent subexpression,
// from first to last, in format:
// String - subexpression text (without '()')
// low word of Object - starting position in ARegExpr, including '('
// if exists! (first position is 1)
// high word of Object - length, including starting '(' and ending ')'
// if exist!
// AExtendedSyntax - must be True if modifier /m will be On while
// using the r.e.
// Useful for GUI editors of r.e. etc (You can find example of using
// in TestRExp.dpr project)
// Returns
// 0      Success. No unbalanced brackets was found;
// -1     There are not enough closing brackets ')';
// -(n+1) At position n was found opening '[' without  //###0.942
// corresponding closing ']';
// n      At position n was found closing bracket ')' without
// corresponding opening '('.
// If Result <> 0, then ASubExpr can contain empty items or illegal ones
function RegExprSubExpressions(const ARegExpr: RegExprString; ASubExprs: TStrings;
  AExtendedSyntax: boolean{$IFDEF DefParam} = False{$ENDIF}): integer;

implementation

{$IFDEF FastUnicodeData}
uses
  regexpr_unicodedata;
{$ENDIF}

const
  // TRegExpr.VersionMajor/Minor return values of these constants:
  REVersionMajor = 1;
  REVersionMinor = 158;

  OpKind_End = REChar(1);
  OpKind_MetaClass = REChar(2);
  OpKind_Range = REChar(3);
  OpKind_Char = REChar(4);
  OpKind_CategoryYes = REChar(5);
  OpKind_CategoryNo = REChar(6);

  RegExprAllSet = [0 .. 255];
  RegExprWordSet = [Ord('a') .. Ord('z'), Ord('A') .. Ord('Z'), Ord('0') .. Ord('9'), Ord('_')];
  RegExprDigitSet = [Ord('0') .. Ord('9')];
  RegExprLowerAzSet = [Ord('a') .. Ord('z')];
  RegExprUpperAzSet = [Ord('A') .. Ord('Z')];
  RegExprAllAzSet = RegExprLowerAzSet + RegExprUpperAzSet;
  RegExprSpaceSet = [Ord(' '), $9, $A, $D, $C];
  RegExprLineSeparatorsSet = [$d, $a, $b, $c] {$IFDEF UnicodeRE} + [$85] {$ENDIF};
  RegExprHorzSeparatorsSet = [9, $20, $A0];

  MaxBracesArg = $7FFFFFFF - 1; // max value for {n,m} arguments //###0.933

type
  TRENextOff = PtrInt;
  // internal Next "pointer" (offset to current p-code) //###0.933
  PRENextOff = ^TRENextOff;
  // used for extracting Next "pointers" from compiled r.e. //###0.933
  TREBracesArg = integer; // type of {m,n} arguments
  PREBracesArg = ^TREBracesArg;

  TREGroupKind = (
    gkNormalGroup,
    gkNonCapturingGroup,
    gkNamedGroupReference,
    gkComment,
    gkModifierString,
    gkLookahead,
    gkLookaheadNeg,
    gkLookbehind,
    gkLookbehindNeg,
    gkRecursion,
    gkSubCall
    );

// Alexey T.: handling of that define FPC_REQUIRES_PROPER_ALIGNMENT was present even 15 years ago,
// but with it, we have failing of some RegEx tests, on ARM64 CPU.
// If I undefine FPC_REQUIRES_PROPER_ALIGNMENT, all tests run OK on ARM64 again.
{$undef FPC_REQUIRES_PROPER_ALIGNMENT}

const
  REOpSz = SizeOf(TREOp) div SizeOf(REChar);
  // size of OP_ command in REChars
  {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  // add space for aligning pointer
  // -1 is the correct max size but also needed for InsertOperator that needs a multiple of pointer size
  RENextOffSz = (2 * SizeOf(TRENextOff) div SizeOf(REChar)) - 1;
  REBracesArgSz = (2 * SizeOf(TREBracesArg) div SizeOf(REChar));
  // add space for aligning pointer
  {$ELSE}
  RENextOffSz = (SizeOf(TRENextOff) div SizeOf(REChar));
  // size of Next pointer in REChars
  REBracesArgSz = SizeOf(TREBracesArg) div SizeOf(REChar);
  // size of BRACES arguments in REChars
  {$ENDIF}
  RENumberSz = SizeOf(LongInt) div SizeOf(REChar);

type
  PtrPair = {$IFDEF UnicodeRE} ^LongInt; {$ELSE} ^Word; {$ENDIF}

function IsPairedBreak(p: PRegExprChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
const
  cBreak = {$IFDEF UnicodeRE} $000D000A; {$ELSE} $0D0A; {$ENDIF}
begin
  Result := PtrPair(p)^ = cBreak;
end;

function _FindCharInBuffer(SBegin, SEnd: PRegExprChar; Ch: REChar): PRegExprChar; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  while SBegin < SEnd do
  begin
    if SBegin^ = Ch then
    begin
      Result := SBegin;
      Exit;
    end;
    Inc(SBegin);
  end;
  Result := nil;
end;

function IsIgnoredChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  case AChar of
    ' ', #9, #$d, #$a:
      Result := True
    else
      Result := False;
  end;
end;

function _IsMetaChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  case AChar of
    'd', 'D',
    's', 'S',
    'w', 'W',
    'v', 'V',
    'h', 'H':
      Result := True
    else
      Result := False;
  end;
end;

function AlignToPtr(const p: Pointer): Pointer; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  Result := Align(p, SizeOf(Pointer));
  {$ELSE}
  Result := p;
  {$ENDIF}
end;

function AlignToInt(const p: Pointer): Pointer; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  {$IFDEF FPC_REQUIRES_PROPER_ALIGNMENT}
  Result := Align(p, SizeOf(integer));
  {$ELSE}
  Result := p;
  {$ENDIF}
end;

{$IFDEF FastUnicodeData}
function _UpperCase(Ch: REChar): REChar; inline;
begin
  Result := CharUpperArray[Ord(Ch)];
end;

function _LowerCase(Ch: REChar): REChar; inline;
begin
  Result := CharLowerArray[Ord(Ch)];
end;

{$ELSE}
function _UpperCase(Ch: REChar): REChar;
begin
  Result := Ch;
  if (Ch >= 'a') and (Ch <= 'z') then
  begin
    Dec(Result, 32);
    Exit;
  end;
  if Ord(Ch) < 128 then
    Exit;

  {$IFDEF FPC}
    {$IFDEF UnicodeRE}
    Result := UnicodeUpperCase(Ch)[1];
    {$ELSE}
    Result := AnsiUpperCase(Ch)[1];
    {$ENDIF}
  {$ELSE}
    {$IFDEF UnicodeRE}
      {$IFDEF D_XE4}
    Result := Ch.ToUpper;
      {$ELSE}
      {$IFDEF D2009}
    Result := TCharacter.ToUpper(Ch);
      {$ENDIF}
    {$ENDIF}
    {$ELSE}
    Result := AnsiUpperCase(Ch)[1];
    {$ENDIF}
  {$ENDIF}
end;

function _LowerCase(Ch: REChar): REChar;
begin
  Result := Ch;
  if (Ch >= 'A') and (Ch <= 'Z') then
  begin
    Inc(Result, 32);
    Exit;
  end;
  if Ord(Ch) < 128 then
    Exit;

  {$IFDEF FPC}
    {$IFDEF UnicodeRE}
    Result := UnicodeLowerCase(Ch)[1];
    {$ELSE}
    Result := AnsiLowerCase(Ch)[1];
    {$ENDIF}
  {$ELSE}
    {$IFDEF UnicodeRE}
      {$IFDEF D_XE4}
    Result := Ch.ToLower;
      {$ELSE}
      {$IFDEF D2009}
    Result := TCharacter.ToLower(Ch);
      {$ENDIF}
    {$ENDIF}
    {$ELSE}
    Result := AnsiLowerCase(Ch)[1];
    {$ENDIF}
  {$ENDIF}
end;
{$ENDIF}

function InvertCase(const Ch: REChar): REChar; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  Result := _UpperCase(Ch);
  if Result = Ch then
    Result := _LowerCase(Ch);
end;

function _FindClosingBracket(P, PEnd: PRegExprChar): PRegExprChar;
var
  Level: integer;
begin
  Result := nil;
  Level := 1;
  repeat
    if P >= PEnd then Exit;
    case P^ of
      EscChar:
        Inc(P);
      '(':
        begin
          Inc(Level);
        end;
      ')':
        begin
          Dec(Level);
          if Level = 0 then
          begin
            Result := P;
            Exit;
          end;
        end;
    end;
    Inc(P);
  until False;
end;

{$IFDEF UNICODEEX}
procedure IncUnicode(var p: PRegExprChar); {$IFDEF InlineFuncs}inline;{$ENDIF}
// make additional increment if we are on low-surrogate AnsiChar
// no need to check p<fInputEnd, at the end of string we have chr(0)
var
  ch: REChar;
begin
  Inc(p);
  ch := p^;
  if (Ord(ch) >= $DC00) and (Ord(ch) <= $DFFF) then
    Inc(p);
end;

procedure IncUnicode2(var p: PRegExprChar; var N: integer); {$IFDEF InlineFuncs}inline;{$ENDIF}
var
  ch: REChar;
begin
  Inc(p);
  Inc(N);
  ch := p^;
  if (Ord(ch) >= $DC00) and (Ord(ch) <= $DFFF) then
  begin
    Inc(p);
    Inc(N);
  end;
end;
{$ENDIF}

{ ============================================================= }
{ ===================== Global functions ====================== }
{ ============================================================= }

function IsModifiersEqual(const A, B: TRegExprModifiers): boolean;
begin
  Result :=
    (A.I = B.I) and
    (A.G = B.G) and
    (A.M = B.M) and
    (A.S = B.S) and
    (A.R = B.R) and
    (A.X = B.X);
end;

function ParseModifiers(const APtr: PRegExprChar;
  ALen: integer;
  var AValue: TRegExprModifiers): boolean;
// Parse string and set AValue if it's in format 'ismxrg-ismxrg'
var
  IsOn: boolean;
  i: integer;
begin
  Result := True;
  IsOn := True;
  for i := 0 to ALen-1 do
    case APtr[i] of
      '-':
        IsOn := False;
      'I', 'i':
        AValue.I := IsOn;
      'R', 'r':
        AValue.R := IsOn;
      'S', 's':
        AValue.S := IsOn;
      'G', 'g':
        AValue.G := IsOn;
      'M', 'm':
        AValue.M := IsOn;
      'X', 'x':
        AValue.X := IsOn;
    else
      begin
        Result := False;
        Exit;
      end;
    end;
end;

function ExecRegExpr(const ARegExpr, AInputStr: RegExprString): boolean;
var
  r: TRegExpr;
begin
  r := TRegExpr.Create;
  try
    r.Expression := ARegExpr;
    Result := r.Exec(AInputStr);
  finally
    r.Free;
  end;
end; { of function ExecRegExpr
  -------------------------------------------------------------- }

procedure SplitRegExpr(const ARegExpr, AInputStr: RegExprString;
  APieces: TStrings);
var
  r: TRegExpr;
begin
  APieces.Clear;
  r := TRegExpr.Create;
  try
    r.Expression := ARegExpr;
    r.Split(AInputStr, APieces);
  finally
    r.Free;
  end;
end; { of procedure SplitRegExpr
  -------------------------------------------------------------- }

function ReplaceRegExpr(const ARegExpr, AInputStr, AReplaceStr: RegExprString;
  AUseSubstitution: boolean{$IFDEF DefParam} = False{$ENDIF}): RegExprString;
begin
  with TRegExpr.Create do
    try
      Expression := ARegExpr;
      Result := Replace(AInputStr, AReplaceStr, AUseSubstitution);
    finally
      Free;
    end;
end; { of function ReplaceRegExpr
  -------------------------------------------------------------- }
{$IFDEF OverMeth}

function ReplaceRegExpr(const ARegExpr, AInputStr, AReplaceStr: RegExprString;
  Options: TRegexReplaceOptions): RegExprString; overload;

begin
  with TRegExpr.Create do
    try
      ModifierI := (rroModifierI in Options);
      ModifierR := (rroModifierR in Options);
      ModifierS := (rroModifierS in Options);
      ModifierG := (rroModifierG in Options);
      ModifierM := (rroModifierM in Options);
      ModifierX := (rroModifierX in Options);
      // Set this after the above, if the regex contains modifiers, they will be applied.
      Expression := ARegExpr;
      if rroUseOsLineEnd in Options then
        ReplaceLineEnd := sLineBreak
      else
        ReplaceLineEnd := #10;
      Result := Replace(AInputStr, AReplaceStr, rroUseSubstitution in Options);
    finally
      Free;
    end;
end;
{$ENDIF}

(*
const
  MetaChars_Init = '^$.[()|?+*' + EscChar + '{';
  MetaChars = MetaChars_Init; // not needed to be a variable, const is faster
  MetaAll = MetaChars_Init + ']}'; // Very similar to MetaChars, but slighly changed.
*)

function _IsMetaSymbol1(ch: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  case ch of
    '^', '$', '.', '[', '(', ')', '|', '?', '+', '*', EscChar, '{':
      Result := True
    else
      Result := False
  end;
end;

function _IsMetaSymbol2(ch: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  case ch of
    '^', '$', '.', '[', '(', ')', '|', '?', '+', '*', EscChar, '{',
    ']', '}':
      Result := True
    else
      Result := False
  end;
end;

function QuoteRegExprMetaChars(const AStr: RegExprString): RegExprString;
var
  i, i0, Len: integer;
  ch: REChar;
begin
  Result := '';
  Len := Length(AStr);
  i := 1;
  i0 := i;
  while i <= Len do
  begin
    ch := AStr[i];
    if _IsMetaSymbol2(ch) then
    begin
      Result := Result + System.Copy(AStr, i0, i - i0) + EscChar + ch;
      i0 := i + 1;
    end;
    Inc(i);
  end;
  Result := Result + System.Copy(AStr, i0, MaxInt); // Tail
end; { of function QuoteRegExprMetaChars
  -------------------------------------------------------------- }

function RegExprSubExpressions(const ARegExpr: RegExprString; ASubExprs: TStrings;
  AExtendedSyntax: boolean{$IFDEF DefParam} = False{$ENDIF}): integer;
type
  TStackItemRec = record // ###0.945
    SubExprIdx: integer;
    StartPos: PtrInt;
  end;

  TStackArray = packed array [0 .. RegexMaxMaxGroups - 1] of TStackItemRec;
var
  Len, SubExprLen: integer;
  i, i0: integer;
  Modif: TRegExprModifiers;
  Stack: ^TStackArray; // ###0.945
  StackIdx, StackSz: integer;
begin
  Result := 0; // no unbalanced brackets found at this very moment
  FillChar(Modif, SizeOf(Modif), 0);
  ASubExprs.Clear; // I don't think that adding to non empty list
  // can be useful, so I simplified algorithm to work only with empty list

  Len := Length(ARegExpr); // some optimization tricks

  // first we have to calculate number of subexpression to reserve
  // space in Stack array (may be we'll reserve more than needed, but
  // it's faster then memory reallocation during parsing)
  StackSz := 1; // add 1 for entire r.e.
  for i := 1 to Len do
    if ARegExpr[i] = '(' then
      Inc(StackSz);
  // SetLength (Stack, StackSz); //###0.945
  GetMem(Stack, SizeOf(TStackItemRec) * StackSz);

  try
    StackIdx := 0;
    i := 1;
    while (i <= Len) do
    begin
      case ARegExpr[i] of
        '(':
          begin
            if (i < Len) and (ARegExpr[i + 1] = '?') then
            begin
              // this is not subexpression, but comment or other
              // Perl extension. We must check is it (?ismxrg-ismxrg)
              // and change AExtendedSyntax if /x is changed.
              Inc(i, 2); // skip '(?'
              i0 := i;
              while (i <= Len) and (ARegExpr[i] <> ')') do
                Inc(i);
              if i > Len then
                Result := -1 // unbalansed '('
              else
              if ParseModifiers(@ARegExpr[i0], i - i0, Modif) then
                // Alexey-T: original code had copy from i, not from i0
                AExtendedSyntax := Modif.X;
            end
            else
            begin // subexpression starts
              ASubExprs.Add(''); // just reserve space
              with Stack[StackIdx] do
              begin
                SubExprIdx := ASubExprs.Count - 1;
                StartPos := i;
              end;
              Inc(StackIdx);
            end;
          end;
        ')':
          begin
            if StackIdx = 0 then
              Result := i // unbalanced ')'
            else
            begin
              Dec(StackIdx);
              with Stack[StackIdx] do
              begin
                SubExprLen := i - StartPos + 1;
                ASubExprs.Objects[SubExprIdx] :=
                  TObject(StartPos or (SubExprLen ShL 16));
                ASubExprs[SubExprIdx] := System.Copy(ARegExpr, StartPos + 1,
                  SubExprLen - 2); // add without brackets
              end;
            end;
          end;
        EscChar:
          Inc(i); // skip quoted symbol
        '[':
          begin
            // we have to skip character ranges at once, because they can
            // contain '#', and '#' in it must NOT be recognized as eXtended
            // comment beginning!
            i0 := i;
            Inc(i);
            if ARegExpr[i] = ']' // first ']' inside [] treated as simple AnsiChar, no need to check '['
            then
              Inc(i);
            while (i <= Len) and (ARegExpr[i] <> ']') do
              if ARegExpr[i] = EscChar // ###0.942
              then
                Inc(i, 2) // skip 'escaped' AnsiChar to prevent stopping at '\]'
              else
                Inc(i);
            if (i > Len) or (ARegExpr[i] <> ']') // ###0.942
            then
              Result := -(i0 + 1); // unbalansed '[' //###0.942
          end;
        '#':
          if AExtendedSyntax then
          begin
            // skip eXtended comments
            while (i <= Len) and (ARegExpr[i] <> #$d) and (ARegExpr[i] <> #$a)
            // do not use [#$d, #$a] due to Unicode compatibility
              do
              Inc(i);
            while (i + 1 <= Len) and
              ((ARegExpr[i + 1] = #$d) or (ARegExpr[i + 1] = #$a)) do
              Inc(i); // attempt to work with different kinds of line separators
            // now we are at the line separator that must be skipped.
          end;
        // here is no 'else' clause - we simply skip ordinary chars
      end; // of case
      Inc(i); // skip scanned AnsiChar
      // ! can move after Len due to skipping quoted symbol
    end;

    // check brackets balance
    if StackIdx <> 0 then
      Result := -1; // unbalansed '('

    // check if entire r.e. added
    if (ASubExprs.Count = 0) or ((PtrInt(ASubExprs.Objects[0]) and $FFFF) <> 1)
      or (((PtrInt(ASubExprs.Objects[0]) ShR 16) and $FFFF) <> Len)
    // whole r.e. wasn't added because it isn't bracketed
    // well, we add it now:
    then
      ASubExprs.InsertObject(0, ARegExpr, TObject((Len ShL 16) or 1));

  finally
    FreeMem(Stack);
  end;
end; { of function RegExprSubExpressions
  -------------------------------------------------------------- }

const
  OP_MAGIC = TREOp(216); // programm signature

  // name            opcode    opnd? meaning
  OP_EEND = TREOp(0); // -    End of program
  OP_BOL = TREOp(1); // -    Match "" at beginning of line
  OP_EOL = TREOp(2); // -    Match "" at end of line
  OP_ANY = TREOp(3); // -    Match any one character
  OP_ANYOF = TREOp(4); // Str  Match any character in string Str
  OP_ANYBUT = TREOp(5); // Str  Match any AnsiChar. not in string Str
  OP_BRANCH = TREOp(6); // Node Match this alternative, or the next
  OP_BACK = TREOp(7); // -    Jump backward (Next < 0)
  OP_EXACTLY = TREOp(8); // Str  Match string Str
  OP_NOTHING = TREOp(9); // -    Match empty string
  OP_STAR = TREOp(10); // Node Match this (simple) thing 0 or more times
  OP_PLUS = TREOp(11); // Node Match this (simple) thing 1 or more times
  OP_ANYDIGIT = TREOp(12); // -    Match any digit (equiv [0-9])
  OP_NOTDIGIT = TREOp(13); // -    Match not digit (equiv [0-9])
  OP_ANYLETTER = TREOp(14); // -    Match any letter from property WordChars
  OP_NOTLETTER = TREOp(15); // -    Match not letter from property WordChars
  OP_ANYSPACE = TREOp(16); // -    Match any space AnsiChar (see property SpaceChars)
  OP_NOTSPACE = TREOp(17); // -    Match not space AnsiChar (see property SpaceChars)
  OP_BRACES = TREOp(18);
  // Node,Min,Max Match this (simple) thing from Min to Max times.
  // Min and Max are TREBracesArg
  OP_COMMENT = TREOp(19); // -    Comment ;)
  OP_EXACTLYCI = TREOp(20); // Str  Match string Str case insensitive
  OP_ANYOFCI = TREOp(21);
  // Str  Match any character in string Str, case insensitive
  OP_ANYBUTCI = TREOp(22);
  // Str  Match any AnsiChar. not in string Str, case insensitive
  OP_LOOPENTRY = TREOp(23); // Node Start of loop (Node - LOOP for this loop)
  OP_LOOP = TREOp(24); // Node,Min,Max,LoopEntryJmp - back jump for LOOPENTRY.
  // Min and Max are TREBracesArg
  // Node - next node in sequence,
  // LoopEntryJmp - associated LOOPENTRY node addr
  OP_EOL2 = TReOp(25); // like OP_EOL but also matches before final line-break
  OP_BSUBEXP = TREOp(28);
  // Idx  Match previously matched subexpression #Idx (stored as REChar) //###0.936
  OP_BSUBEXPCI = TREOp(29); // Idx  -"- in case-insensitive mode

  // Non-Greedy Style Ops //###0.940
  OP_STARNG = TREOp(30); // Same as OP_START but in non-greedy mode
  OP_PLUSNG = TREOp(31); // Same as OP_PLUS but in non-greedy mode
  OP_BRACESNG = TREOp(32); // Same as OP_BRACES but in non-greedy mode
  OP_LOOPNG = TREOp(33); // Same as OP_LOOP but in non-greedy mode

  // Multiline mode \m
  OP_BOLML = TREOp(34); // -    Match "" at beginning of line
  OP_EOLML = TREOp(35); // -    Match "" at end of line
  OP_ANYML = TREOp(36); // -    Match any one character

  // Word boundary
  OP_BOUND = TREOp(37); // Match "" between words //###0.943
  OP_NOTBOUND = TREOp(38); // Match "" not between words //###0.943

  OP_ANYHORZSEP = TREOp(39); // Any horizontal whitespace \h
  OP_NOTHORZSEP = TREOp(40); // Not horizontal whitespace \H
  OP_ANYVERTSEP = TREOp(41); // Any vertical whitespace \v
  OP_NOTVERTSEP = TREOp(42); // Not vertical whitespace \V

  OP_ANYCATEGORY = TREOp(43); // \p{L}
  OP_NOTCATEGORY = TREOp(44); // \P{L}

  OP_STAR_POSS = TReOp(45);
  OP_PLUS_POSS = TReOp(46);
  OP_BRACES_POSS = TReOp(47);

  OP_RECUR = TReOp(48);

  // !!! Change OP_OPEN value if you add new opcodes !!!

  OP_OPEN = TREOp(50); // Opening of group; OP_OPEN+i is for group i
  OP_OPEN_FIRST = Succ(OP_OPEN);
  OP_OPEN_LAST = TREOp(Ord(OP_OPEN) + RegexMaxGroups - 1);

  OP_CLOSE = Succ(OP_OPEN_LAST); // Closing of group; OP_CLOSE+i is for group i
  OP_CLOSE_FIRST = Succ(OP_CLOSE);
  OP_CLOSE_LAST = TReOp(Ord(OP_CLOSE) + RegexMaxGroups - 1);

  OP_SUBCALL = Succ(OP_CLOSE_LAST); // Call of subroutine; OP_SUBCALL+i is for group i
  OP_SUBCALL_FIRST = Succ(OP_SUBCALL);
  OP_SUBCALL_LAST =
    {$IFDEF UnicodeRE}
    TReOp(Ord(OP_SUBCALL) + RegexMaxGroups - 1);
    {$ELSE}
    High(REChar); // must fit to 0..255 range
    {$ENDIF}

  // We work with p-code through pointers, compatible with PRegExprChar.
  // Note: all code components (TRENextOff, TREOp, TREBracesArg, etc)
  // must have lengths that can be divided by SizeOf (REChar) !
  // A node is TREOp of opcode followed Next "pointer" of TRENextOff type.
  // The Next is a offset from the opcode of the node containing it.
  // An operand, if any, simply follows the node. (Note that much of
  // the code generation knows about this implicit relationship!)
  // Using TRENextOff=PtrInt speed up p-code processing.

  // Opcodes description:
  //
  // BRANCH The set of branches constituting a single choice are hooked
  // together with their "next" pointers, since precedence prevents
  // anything being concatenated to any individual branch. The
  // "next" pointer of the last BRANCH in a choice points to the
  // thing following the whole choice. This is also where the
  // final "next" pointer of each individual branch points; each
  // branch starts with the operand node of a BRANCH node.
  // BACK Normal "next" pointers all implicitly point forward; BACK
  // exists to make loop structures possible.
  // STAR,PLUS,BRACES '?', and complex '*' and '+', are implemented as
  // circular BRANCH structures using BACK. Complex '{min,max}'
  // - as pair LOOPENTRY-LOOP (see below). Simple cases (one
  // character per match) are implemented with STAR, PLUS and
  // BRACES for speed and to minimize recursive plunges.
  // LOOPENTRY,LOOP {min,max} are implemented as special pair
  // LOOPENTRY-LOOP. Each LOOPENTRY initialize loopstack for
  // current level.
  // OPEN,CLOSE are numbered at compile time.

  { ============================================================= }
  { ================== Error handling section =================== }
  { ============================================================= }

const
  reeOk = 0;
  reeCompNullArgument = 100;
  reeUnknownMetaSymbol = 101;
  reeCompParseRegTooManyBrackets = 102;
  reeCompParseRegUnmatchedBrackets = 103;
  reeCompParseRegUnmatchedBrackets2 = 104;
  reeCompParseRegJunkOnEnd = 105;
  reePlusStarOperandCouldBeEmpty = 106;
  reeNestedQuantif = 107;
  reeBadHexDigit = 108;
  reeInvalidRange = 109;
  reeParseAtomTrailingBackSlash = 110;
  reeNoHexCodeAfterBSlashX = 111;
  reeHexCodeAfterBSlashXTooBig = 112;
  reeUnmatchedSqBrackets = 113;
  reeInternalUrp = 114;
  reeQuantifFollowsNothing = 115;
  reeTrailingBackSlash = 116;
  reeNoLetterAfterBSlashC = 117;
  reeMetaCharAfterMinusInRange = 118;
  reeRarseAtomInternalDisaster = 119;
  reeIncorrectSpecialBrackets = 120;
  reeIncorrectBraces = 121;
  reeBRACESArgTooBig = 122;
  reeUnknownOpcodeInFillFirst = 123;
  reeBracesMinParamGreaterMax = 124;
  reeUnclosedComment = 125;
  reeComplexBracesNotImplemented = 126;
  reeUnrecognizedModifier = 127;
  reeBadLinePairedSeparator = 128;
  reeBadUnicodeCategory = 129;
  reeTooSmallCheckersArray = 130;
  reePossessiveAfterComplexBraces = 131;
  reeBadRecursion = 132;
  reeBadSubCall = 133;
  reeNamedGroupBad = 140;
  reeNamedGroupBadName = 141;
  reeNamedGroupBadRef = 142;
  reeNamedGroupDupName = 143;
  reeLookaheadBad = 150;
  reeLookbehindBad = 152;
  reeLookbehindTooComplex = 153;
  reeLookaroundNotAtEdge = 154;
  // Runtime errors must be >= reeFirstRuntimeCode
  reeFirstRuntimeCode = 1000;
  reeRegRepeatCalledInappropriately = 1000;
  reeMatchPrimMemoryCorruption = 1001;
  reeMatchPrimCorruptedPointers = 1002;
  reeNoExpression = 1003;
  reeCorruptedProgram = 1004;
  reeOffsetMustBePositive = 1006;
  reeExecNextWithoutExec = 1007;
  reeBadOpcodeInCharClass = 1008;
  reeDumpCorruptedOpcode = 1011;
  reeModifierUnsupported = 1013;
  reeLoopStackExceeded = 1014;
  reeLoopWithoutEntry = 1015;

function TRegExpr.ErrorMsg(AErrorID: integer): RegExprString;
begin
  case AErrorID of
    reeOk:
      Result := 'No errors';
    reeCompNullArgument:
      Result := 'TRegExpr compile: null argument';
    reeUnknownMetaSymbol:
      Result := 'TRegExpr compile: unknown meta-character: \' + fLastErrorSymbol;
    reeCompParseRegTooManyBrackets:
      Result := 'TRegExpr compile: ParseReg: too many ()';
    reeCompParseRegUnmatchedBrackets:
      Result := 'TRegExpr compile: ParseReg: unmatched ()';
    reeCompParseRegUnmatchedBrackets2:
      Result := 'TRegExpr compile: ParseReg: unmatched ()';
    reeCompParseRegJunkOnEnd:
      Result := 'TRegExpr compile: ParseReg: junk at end';
    reePlusStarOperandCouldBeEmpty:
      Result := 'TRegExpr compile: *+ operand could be empty';
    reeNestedQuantif:
      Result := 'TRegExpr compile: nested quantifier *?+';
    reeBadHexDigit:
      Result := 'TRegExpr compile: bad hex digit';
    reeInvalidRange:
      Result := 'TRegExpr compile: invalid [] range';
    reeParseAtomTrailingBackSlash:
      Result := 'TRegExpr compile: parse atom trailing \';
    reeNoHexCodeAfterBSlashX:
      Result := 'TRegExpr compile: no hex code after \x';
    reeNoLetterAfterBSlashC:
      Result := 'TRegExpr compile: no letter "A".."Z" after \c';
    reeMetaCharAfterMinusInRange:
      Result := 'TRegExpr compile: metachar after "-" in [] range';
    reeHexCodeAfterBSlashXTooBig:
      Result := 'TRegExpr compile: hex code after \x is too big';
    reeUnmatchedSqBrackets:
      Result := 'TRegExpr compile: unmatched []';
    reeInternalUrp:
      Result := 'TRegExpr compile: internal fail on AnsiChar "|", ")"';
    reeQuantifFollowsNothing:
      Result := 'TRegExpr compile: quantifier ?+*{ follows nothing';
    reeTrailingBackSlash:
      Result := 'TRegExpr compile: trailing \';
    reeRarseAtomInternalDisaster:
      Result := 'TRegExpr compile: RarseAtom internal disaster';
    reeIncorrectSpecialBrackets:
      Result := 'TRegExpr compile: incorrect expression in (?...) brackets';
    reeIncorrectBraces:
      Result := 'TRegExpr compile: incorrect {} braces';
    reeBRACESArgTooBig:
      Result := 'TRegExpr compile: braces {} argument too big';
    reeUnknownOpcodeInFillFirst:
      Result := 'TRegExpr compile: unknown opcode in FillFirstCharSet ('+DumpOp(fLastErrorOpcode)+')';
    reeBracesMinParamGreaterMax:
      Result := 'TRegExpr compile: braces {} min param greater then max';
    reeUnclosedComment:
      Result := 'TRegExpr compile: unclosed (?#comment)';
    reeComplexBracesNotImplemented:
      Result := 'TRegExpr compile: if you use braces {} and non-greedy ops *?, +?, ?? for complex cases, enable {$DEFINE ComplexBraces}';
    reeUnrecognizedModifier:
      Result := 'TRegExpr compile: incorrect modifier in (?...)';
    reeBadLinePairedSeparator:
      Result := 'TRegExpr compile: LinePairedSeparator must countain two different chars or be empty';
    reeBadUnicodeCategory:
      Result := 'TRegExpr compile: invalid category after \p or \P';
    reeTooSmallCheckersArray:
      Result := 'TRegExpr compile: too small CharCheckers array';
    reePossessiveAfterComplexBraces:
      Result := 'TRegExpr compile: possessive + after complex braces: (foo){n,m}+';
    reeBadRecursion:
      Result := 'TRegExpr compile: bad recursion (?R)';
    reeBadSubCall:
      Result := 'TRegExpr compile: bad subroutine call';
    reeNamedGroupBad:
      Result := 'TRegExpr compile: bad named group';
    reeNamedGroupBadName:
      Result := 'TRegExpr compile: bad identifier in named group';
    reeNamedGroupBadRef:
      Result := 'TRegExpr compile: bad back-reference to named group';
    reeNamedGroupDupName:
      Result := 'TRegExpr compile: named group defined more than once';
    reeLookaheadBad:
      Result := 'TRegExpr compile: bad lookahead';
    reeLookbehindBad:
      Result := 'TRegExpr compile: bad lookbehind';
    reeLookbehindTooComplex:
      Result := 'TRegExpr compile: lookbehind (?<!foo) must have fixed length';
    reeLookaroundNotAtEdge:
      Result := 'TRegExpr compile: lookaround brackets must be at the very beginning/ending';

    reeRegRepeatCalledInappropriately:
      Result := 'TRegExpr exec: RegRepeat called inappropriately';
    reeMatchPrimMemoryCorruption:
      Result := 'TRegExpr exec: MatchPrim memory corruption';
    reeMatchPrimCorruptedPointers:
      Result := 'TRegExpr exec: MatchPrim corrupted pointers';
    reeNoExpression:
      Result := 'TRegExpr exec: empty expression';
    reeCorruptedProgram:
      Result := 'TRegExpr exec: corrupted opcode (no magic byte)';
    reeOffsetMustBePositive:
      Result := 'TRegExpr exec: offset must be >0';
    reeExecNextWithoutExec:
      Result := 'TRegExpr exec: ExecNext without Exec(Pos)';
    reeBadOpcodeInCharClass:
      Result := 'TRegExpr exec: invalid opcode in AnsiChar class';
    reeDumpCorruptedOpcode:
      Result := 'TRegExpr dump: corrupted opcode';
    reeLoopStackExceeded:
      Result := 'TRegExpr exec: loop stack exceeded';
    reeLoopWithoutEntry:
      Result := 'TRegExpr exec: loop without loop entry';
  else
    Result := 'Unknown error';
  end;
end; { of procedure TRegExpr.Error
  -------------------------------------------------------------- }

function TRegExpr.LastError: integer;
begin
  Result := fLastError;
  fLastError := reeOk;
end; { of function TRegExpr.LastError
  -------------------------------------------------------------- }

{ ============================================================= }
{ ===================== Common section ======================== }
{ ============================================================= }

class function TRegExpr.VersionMajor: integer;
begin
  Result := REVersionMajor;
end;

class function TRegExpr.VersionMinor: integer;
begin
  Result := REVersionMinor;
end;

constructor TRegExpr.Create;
begin
  inherited;
  programm := nil;
  fExpression := '';
  fInputString := '';

  FillChar(fModifiers, SizeOf(fModifiers), 0);
  fModifiers.I := RegExprModifierI;
  fModifiers.R := RegExprModifierR;
  fModifiers.S := RegExprModifierS;
  fModifiers.G := RegExprModifierG;
  fModifiers.M := RegExprModifierM;
  fModifiers.X := RegExprModifierX;

  {$IFDEF UseSpaceChars}
  SpaceChars := RegExprSpaceChars;
  {$ENDIF}
  {$IFDEF UseWordChars}
  WordChars := RegExprWordChars;
  {$ENDIF}

  {$IFDEF UseLineSep}
  fLineSeparators := RegExprLineSeparators;
  {$ENDIF}

  fUsePairedBreak := RegExprUsePairedBreak;
  fReplaceLineEnd := RegExprReplaceLineBreak;

  fSlowChecksSizeMax := 2000;

  {$IFDEF UseLineSep}
  InitLineSepArray;
  {$ENDIF}

  InitCharCheckers;

  {$IFDEF Compat}
  fInvertCase := OldInvertCase;
  {$ENDIF}
end; { of constructor TRegExpr.Create
  -------------------------------------------------------------- }

{$IFDEF OverMeth}
constructor TRegExpr.Create(const AExpression: RegExprString);
begin
  Create;
  Expression := AExpression;
end;
{$ENDIF}

destructor TRegExpr.Destroy;
begin
  if programm <> nil then
  begin
    FreeMem(programm);
    programm := nil;
  end;

  if Assigned(fHelper) then
    FreeAndNil(fHelper);
end;

procedure TRegExpr.SetExpression(const AStr: RegExprString);
begin
  if (AStr <> fExpression) or not IsCompiled then
  begin
    fExpression := AStr;
    UniqueString(fExpression);
    fRegexStart := PRegExprChar(fExpression);
    fRegexEnd := fRegexStart + Length(fExpression);
    InvalidateProgramm;
  end;
end; { of procedure TRegExpr.SetExpression
  -------------------------------------------------------------- }

function TRegExpr.GetSubExprCount: integer;
begin
  // if nothing found, we must return -1 per TRegExpr docs
  if GrpBounds[0].GrpStart[0] = nil then
    Result := -1
  else
    Result := GrpCount;
end;

function TRegExpr.GetMatchPos(Idx: integer): PtrInt;
begin
  Idx := GrpIndexes[Idx];
  if (Idx >= 0) and (GrpBounds[0].GrpStart[Idx] <> nil) then
    Result := GrpBounds[0].GrpStart[Idx] - fInputStart + 1
  else
    Result := -1;
end; { of function TRegExpr.GetMatchPos
  -------------------------------------------------------------- }

function TRegExpr.GetMatchLen(Idx: integer): PtrInt;
begin
  Idx := GrpIndexes[Idx];
  if (Idx >= 0) and (GrpBounds[0].GrpStart[Idx] <> nil) then
    Result := GrpBounds[0].GrpEnd[Idx] - GrpBounds[0].GrpStart[Idx]
  else
    Result := -1;
end; { of function TRegExpr.GetMatchLen
  -------------------------------------------------------------- }

function TRegExpr.GetMatch(Idx: integer): RegExprString;
begin
  Result := '';
  Idx := GrpIndexes[Idx];
  if (Idx >= 0) and (GrpBounds[0].GrpEnd[Idx] > GrpBounds[0].GrpStart[Idx]) then
    SetString(Result, GrpBounds[0].GrpStart[Idx], GrpBounds[0].GrpEnd[Idx] - GrpBounds[0].GrpStart[Idx]);
end; { of function TRegExpr.GetMatch
  -------------------------------------------------------------- }

function TRegExpr.MatchIndexFromName(const AName: RegExprString): integer;
var
  i: integer;
begin
  for i := 1 {not 0} to GrpCount do
    if GrpNames[i] = AName then
    begin
      Result := i;
      Exit;
    end;
  Result := -1;
end;

function TRegExpr.MatchFromName(const AName: RegExprString): RegExprString;
var
  Idx: integer;
begin
  Idx := MatchIndexFromName(AName);
  if Idx >= 0 then
    Result := GetMatch(Idx)
  else
    Result := '';
end;

function TRegExpr.GetModifierStr: RegExprString;
begin
  Result := '-';

  if ModifierI then
    Result := 'i' + Result
  else
    Result := Result + 'i';
  if ModifierR then
    Result := 'r' + Result
  else
    Result := Result + 'r';
  if ModifierS then
    Result := 's' + Result
  else
    Result := Result + 's';
  if ModifierG then
    Result := 'g' + Result
  else
    Result := Result + 'g';
  if ModifierM then
    Result := 'm' + Result
  else
    Result := Result + 'm';
  if ModifierX then
    Result := 'x' + Result
  else
    Result := Result + 'x';

  if Result[Length(Result)] = '-' // remove '-' if all modifiers are 'On'
  then
    System.Delete(Result, Length(Result), 1);
end; { of function TRegExpr.GetModifierStr
  -------------------------------------------------------------- }

procedure TRegExpr.SetModifierG(AValue: boolean);
begin
  if fModifiers.G <> AValue then
  begin
    fModifiers.G := AValue;
    InvalidateProgramm;
  end;
end;

procedure TRegExpr.SetModifierI(AValue: boolean);
begin
  if fModifiers.I <> AValue then
  begin
    fModifiers.I := AValue;
    InvalidateProgramm;
  end;
end;

procedure TRegExpr.SetModifierM(AValue: boolean);
begin
  if fModifiers.M <> AValue then
  begin
    fModifiers.M := AValue;
    InvalidateProgramm;
  end;
end;

procedure TRegExpr.SetModifierR(AValue: boolean);
begin
  if fModifiers.R <> AValue then
  begin
    fModifiers.R := AValue;
    InvalidateProgramm;
  end;
end;

procedure TRegExpr.SetModifierS(AValue: boolean);
begin
  if fModifiers.S <> AValue then
  begin
    fModifiers.S := AValue;
    InvalidateProgramm;
  end;
end;

procedure TRegExpr.SetModifierX(AValue: boolean);
begin
  if fModifiers.X <> AValue then
  begin
    fModifiers.X := AValue;
    InvalidateProgramm;
  end;
end;

procedure TRegExpr.SetModifierStr(const AStr: RegExprString);
begin
  if ParseModifiers(PRegExprChar(AStr), Length(AStr), fModifiers) then
    InvalidateProgramm
  else
    Error(reeModifierUnsupported);
end;

{ ============================================================= }
{ ==================== Compiler section ======================= }
{ ============================================================= }

{$IFDEF FastUnicodeData}
function TRegExpr.IsWordChar(AChar: REChar): boolean;
begin
  // bit 7 in value: is word AnsiChar
  Result := CharCategoryArray[Ord(AChar)] and 128 <> 0;
end;

(*
  // Unicode General Category
  UGC_UppercaseLetter         = 0; Lu
  UGC_LowercaseLetter         = 1; Ll
  UGC_TitlecaseLetter         = 2; Lt
  UGC_ModifierLetter          = 3; Lm
  UGC_OtherLetter             = 4; Lo

  UGC_NonSpacingMark          = 5; Mn
  UGC_CombiningMark           = 6; Mc
  UGC_EnclosingMark           = 7; Me

  UGC_DecimalNumber           = 8; Nd
  UGC_LetterNumber            = 9; Nl
  UGC_OtherNumber             = 10; No

  UGC_ConnectPunctuation      = 11; Pc
  UGC_DashPunctuation         = 12; Pd
  UGC_OpenPunctuation         = 13; Ps
  UGC_ClosePunctuation        = 14; Pe
  UGC_InitialPunctuation      = 15; Pi
  UGC_FinalPunctuation        = 16; Pf
  UGC_OtherPunctuation        = 17; Po

  UGC_MathSymbol              = 18; Sm
  UGC_CurrencySymbol          = 19; Sc
  UGC_ModifierSymbol          = 20; Sk
  UGC_OtherSymbol             = 21; So

  UGC_SpaceSeparator          = 22; Zs
  UGC_LineSeparator           = 23; Zl
  UGC_ParagraphSeparator      = 24; Zp

  UGC_Control                 = 25; Cc
  UGC_Format                  = 26; Cf
  UGC_Surrogate               = 27; Cs
  UGC_PrivateUse              = 28; Co
  UGC_Unassigned              = 29; Cn
*)

const
  CategoryNames: array[0..29] of array[0..1] of REChar = (
    ('L', 'u'),
    ('L', 'l'),
    ('L', 't'),
    ('L', 'm'),
    ('L', 'o'),
    ('M', 'n'),
    ('M', 'c'),
    ('M', 'e'),
    ('N', 'd'),
    ('N', 'l'),
    ('N', 'o'),
    ('P', 'c'),
    ('P', 'd'),
    ('P', 's'),
    ('P', 'e'),
    ('P', 'i'),
    ('P', 'f'),
    ('P', 'o'),
    ('S', 'm'),
    ('S', 'c'),
    ('S', 'k'),
    ('S', 'o'),
    ('Z', 's'),
    ('Z', 'l'),
    ('Z', 'p'),
    ('C', 'c'),
    ('C', 'f'),
    ('C', 's'),
    ('C', 'o'),
    ('C', 'n')
    );

function IsCategoryFirstChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  case AChar of
    'L', 'M', 'N', 'P', 'S', 'C', 'Z':
      Result := True;
    else
      Result := False;
  end;
end;

function IsCategoryChars(AChar, AChar2: REChar): boolean;
var
  i: integer;
begin
  for i := Low(CategoryNames) to High(CategoryNames) do
    if (AChar = CategoryNames[i][0]) then
      if (AChar2 = CategoryNames[i][1]) then
      begin
        Result := True;
        Exit
      end;
  Result := False;
end;

function CheckCharCategory(AChar: REChar; Ch0, Ch1: REChar): boolean;
// AChar: check this AnsiChar against opcode
// Ch0, Ch1: opcode operands after OP_*CATEGORY
var
  N: byte;
  Name0, Name1: REChar;
begin
  Result := False;
  // bits 0..6 are category
  N := CharCategoryArray[Ord(AChar)] and 127;
  if N <= High(CategoryNames) then
  begin
    Name0 := CategoryNames[N][0];
    Name1 := CategoryNames[N][1];
    if Ch0 <> Name0 then Exit;
    if Ch1 <> #0 then
      if Ch1 <> Name1 then Exit;
    Result := True;
  end;
end;

function MatchOneCharCategory(opnd, scan: PRegExprChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
// opnd: points to opcode operands after OP_*CATEGORY
// scan: points into InputString
begin
  Result := CheckCharCategory(scan^, opnd^, (opnd + 1)^);
end;

{$ELSE}
function TRegExpr.IsWordChar(AChar: REChar): boolean;
begin
  {$IFDEF UseWordChars}
  Result := Pos(AChar, fWordChars) > 0;
  {$ELSE}
  case AChar of
    'a' .. 'z',
    'A' .. 'Z',
    '0' .. '9', '_':
      Result := True
    else
      Result := False;
  end;
  {$ENDIF}
end;
{$ENDIF}

function TRegExpr.IsSpaceChar(AChar: REChar): boolean;
begin
  {$IFDEF UseSpaceChars}
  Result := Pos(AChar, fSpaceChars) > 0;
  {$ELSE}
  case AChar of
    ' ', #$9, #$A, #$D, #$C:
      Result := True
    else
      Result := False;
  end;
  {$ENDIF}
end;

function TRegExpr.IsCustomLineSeparator(AChar: REChar): boolean;
begin
  {$IFDEF UseLineSep}
    {$IFDEF UnicodeRE}
    Result := Pos(AChar, fLineSeparators) > 0;
    {$ELSE}
    Result := fLineSepArray[byte(AChar)];
    {$ENDIF}
  {$ELSE}
  case AChar of
    #$d, #$a,
    {$IFDEF UnicodeRE}
    #$85, #$2028, #$2029,
    {$ENDIF}
    #$b, #$c:
      Result := True;
    else
      Result := False;
  end;
  {$ENDIF}
end;

function IsDigitChar(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  case AChar of
    '0' .. '9':
      Result := True;
  else
    Result := False;
  end;
end;

function IsHorzSeparator(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  // Tab and Unicode categoty "Space Separator": https://www.compart.com/en/unicode/category/Zs
  case AChar of
    #9, #$20, #$A0:
      Result := True;
    {$IFDEF UnicodeRE}
    #$1680, #$2000 .. #$200A, #$202F, #$205F, #$3000:
      Result := True;
    {$ENDIF}
  else
    Result := False;
  end;
end;

function IsVertLineSeparator(AChar: REChar): boolean; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  case AChar of
    #$d, #$a, #$b, #$c:
      Result := True;
    {$IFDEF UnicodeRE}
    #$2028, #$2029, #$85:
      Result := True;
    {$ENDIF}
  else
    Result := False;
  end;
end;

procedure TRegExpr.InvalidateProgramm;
begin
  if programm <> nil then
  begin
    FreeMem(programm);
    programm := nil;
  end;
end; { of procedure TRegExpr.InvalidateProgramm
  -------------------------------------------------------------- }

procedure TRegExpr.Compile;
begin
  if fExpression = '' then
  begin
    Error(reeNoExpression);
    Exit;
  end;

  CompileRegExpr(fRegexStart);
end; { of procedure TRegExpr.Compile
  -------------------------------------------------------------- }

{$IFDEF UseLineSep}
procedure TRegExpr.InitLineSepArray;
{$IFNDEF UnicodeRE}
var
  i: integer;
{$ENDIF}
begin
  {$IFNDEF UnicodeRE}
  FillChar(fLineSepArray, SizeOf(fLineSepArray), 0);
  for i := 1 to Length(fLineSeparators) do
    fLineSepArray[byte(fLineSeparators[i])] := True;
  {$ENDIF}
end;
{$ENDIF}

function TRegExpr.IsProgrammOk: boolean;
begin
  Result := False;

  // check modifiers
  if not IsModifiersEqual(fModifiers, fProgModifiers) then
    InvalidateProgramm;

  // compile if needed
  if programm = nil then
  begin
    Compile;
    // Check compiled programm
    if programm = nil then
      Exit;
  end;

  if programm[0] <> OP_MAGIC then
    Error(reeCorruptedProgram)
  else
    Result := True;
end; { of function TRegExpr.IsProgrammOk
  -------------------------------------------------------------- }

procedure TRegExpr.Tail(p: PRegExprChar; val: PRegExprChar);
// set the next-pointer at the end of a node chain
var
  scan: PRegExprChar;
  temp: PRegExprChar;
begin
  if p = @regDummy then
    Exit;
  // Find last node.
  scan := p;
  repeat
    temp := regNext(scan);
    if temp = nil then
      Break;
    scan := temp;
  until False;
  // Set Next 'pointer'
  if val < scan then
    PRENextOff(AlignToPtr(scan + REOpSz))^ := -(scan - val) // ###0.948
    // work around PWideChar subtraction bug (Delphi uses
    // shr after subtraction to calculate widechar distance %-( )
    // so, if difference is negative we have .. the "feature" :(
    // I could wrap it in $IFDEF UnicodeRE, but I didn't because
    // "P – Q computes the difference between the address given
    // by P (the higher address) and the address given by Q (the
    // lower address)" - Delphi help quotation.
  else
    PRENextOff(AlignToPtr(scan + REOpSz))^ := val - scan; // ###0.933
end; { of procedure TRegExpr.Tail
  -------------------------------------------------------------- }

procedure TRegExpr.OpTail(p: PRegExprChar; val: PRegExprChar);
// regtail on operand of first argument; nop if operandless
begin
  // "Operandless" and "op != OP_BRANCH" are synonymous in practice.
  if (p = nil) or (p = @regDummy) or (PREOp(p)^ <> OP_BRANCH) then
    Exit;
  Tail(p + REOpSz + RENextOffSz, val); // ###0.933
end; { of procedure TRegExpr.OpTail
  -------------------------------------------------------------- }

function TRegExpr.EmitNode(op: TREOp): PRegExprChar; // ###0.933
// emit a node, return location
begin
  Result := regCode;
  if Result <> @regDummy then
  begin
    PREOp(regCode)^ := op;
    Inc(regCode, REOpSz);
    PRENextOff(AlignToPtr(regCode))^ := 0; // Next "pointer" := nil
    Inc(regCode, RENextOffSz);

    if (op = OP_EXACTLY) or (op = OP_EXACTLYCI) then
      regExactlyLen := PLongInt(regCode)
    else
      regExactlyLen := nil;

    {$IFDEF DebugSynRegExpr}
    if regcode - programm > regsize then
      raise Exception.Create('TRegExpr.EmitNode buffer overrun');
    {$ENDIF}
  end
  else
    Inc(regCodeSize, REOpSz + RENextOffSz);
    // compute code size without code generation
end; { of function TRegExpr.EmitNode
  -------------------------------------------------------------- }

procedure TRegExpr.EmitC(ch: REChar);
begin
  if regCode <> @regDummy then
  begin
    regCode^ := ch;
    Inc(regCode);
    {$IFDEF DebugSynRegExpr}
    if regcode - programm > regsize then
      raise Exception.Create('TRegExpr.EmitC buffer overrun');
    {$ENDIF}
  end
  else
    Inc(regCodeSize, REOpSz); // Type of p-code pointer always is ^REChar
end; { of procedure TRegExpr.EmitC
  -------------------------------------------------------------- }

procedure TRegExpr.EmitInt(AValue: LongInt);
begin
  if regCode <> @regDummy then
  begin
    PLongInt(regCode)^ := AValue;
    Inc(regCode, RENumberSz);
    {$IFDEF DebugSynRegExpr}
    if regcode - programm > regsize then
      raise Exception.Create('TRegExpr.EmitInt buffer overrun');
    {$ENDIF}
  end
  else
    Inc(regCodeSize, RENumberSz);
end;

function TRegExpr.EmitGroupRef(AIndex: integer; AIgnoreCase: boolean): PRegExprChar;
begin
  if AIgnoreCase then
    Result := EmitNode(OP_BSUBEXPCI)
  else
    Result := EmitNode(OP_BSUBEXP);
  EmitC(REChar(AIndex));
end;

{$IFDEF FastUnicodeData}
procedure TRegExpr.FindCategoryName(var scan: PRegExprChar; var ch1, ch2: REChar);
// scan: points into regex string after '\p', to find category name
// ch1, ch2: 2-AnsiChar name of category; ch2 can be #0
var
  ch: REChar;
  pos1, pos2, namePtr: PRegExprChar;
  nameLen: integer;
begin
  ch1 := #0;
  ch2 := #0;
  ch := scan^;
  if IsCategoryFirstChar(ch) then
  begin
    ch1 := ch;
    Exit;
  end;
  if ch = '{' then
  begin
    pos1 := scan;
    pos2 := pos1;
    while (pos2 < fRegexEnd) and (pos2^ <> '}') do
      Inc(pos2);
    if pos2 >= fRegexEnd then
      Error(reeIncorrectBraces);

    namePtr := pos1+1;
    nameLen := pos2-pos1-1;
    Inc(scan, nameLen+1);

    if nameLen<1 then
      Error(reeBadUnicodeCategory);
    if nameLen>2 then
      Error(reeBadUnicodeCategory);

    if nameLen = 1 then
    begin
      ch1 := namePtr^;
      ch2 := #0;
      if not IsCategoryFirstChar(ch1) then
        Error(reeBadUnicodeCategory);
      Exit;
    end;

    if nameLen = 2 then
    begin
      ch1 := namePtr^;
      ch2 := (namePtr+1)^;
      if not IsCategoryChars(ch1, ch2) then
        Error(reeBadUnicodeCategory);
      Exit;
    end;
  end
  else
    Error(reeBadUnicodeCategory);
end;

function TRegExpr.EmitCategoryMain(APositive: boolean): PRegExprChar;
var
  ch, ch2: REChar;
begin
  Inc(regParse);
  if regParse >= fRegexEnd then
    Error(reeBadUnicodeCategory);
  FindCategoryName(regParse, ch, ch2);
  if APositive then
    Result := EmitNode(OP_ANYCATEGORY)
  else
    Result := EmitNode(OP_NOTCATEGORY);
  EmitC(ch);
  EmitC(ch2);
end;
{$ENDIF}

procedure TRegExpr.InsertOperator(op: TREOp; opnd: PRegExprChar; sz: integer);
// insert an operator in front of already-emitted operand
// Means relocating the operand.
var
  src, dst, place: PRegExprChar;
  i: integer;
begin
  if regCode = @regDummy then
  begin
    Inc(regCodeSize, sz);
    Exit;
  end;
  // move code behind insert position
  src := regCode;
  Inc(regCode, sz);
  {$IFDEF DebugSynRegExpr}
  if regCode - programm > regCodeSize then
    raise Exception.Create('TRegExpr.InsertOperator buffer overrun');
  // if (opnd<regCode) or (opnd-regCode>regCodeSize) then
  // raise Exception.Create('TRegExpr.InsertOperator invalid opnd');
  {$ENDIF}
  dst := regCode;
  while src > opnd do
  begin
    Dec(dst);
    Dec(src);
    dst^ := src^;
  end;
  place := opnd; // Op node, where operand used to be.
  PREOp(place)^ := op;
  Inc(place, REOpSz);
  for i := 1 + REOpSz to sz do
  begin
    place^ := #0;
    Inc(place);
  end;
end; { of procedure TRegExpr.InsertOperator
  -------------------------------------------------------------- }

function FindSkippedMetaLen(PStart, PEnd: PRegExprChar): integer; {$IFDEF InlineFuncs}inline;{$ENDIF}
// find length of initial segment of PStart string consisting
// entirely of characters not from IsMetaSymbol1.
begin
  Result := 0;
  while PStart < PEnd do
  begin
    if _IsMetaSymbol1(PStart^) then
      Exit;
    Inc(Result);
    Inc(PStart)
  end;
end;

const
  // Flags to be passed up and down.
  FLAG_WORST = 0; // Worst case
  FLAG_HASWIDTH = 1; // Cannot match empty string
  FLAG_SIMPLE = 2; // Simple enough to be OP_STAR/OP_PLUS/OP_BRACES operand
  FLAG_SPECSTART = 4; // Starts with * or +

  {$IFDEF UnicodeRE}
  RusRangeLoLow = #$430; // 'а'
  RusRangeLoHigh = #$44F; // 'я'
  RusRangeHiLow = #$410; // 'А'
  RusRangeHiHigh = #$42F; // 'Я'
  {$ELSE}
  RusRangeLoLow = #$E0; // 'а' in cp1251
  RusRangeLoHigh = #$FF; // 'я' in cp1251
  RusRangeHiLow = #$C0; // 'А' in cp1251
  RusRangeHiHigh = #$DF; // 'Я' in cp1251
  {$ENDIF}

function TRegExpr.FindInCharClass(ABuffer: PRegExprChar; AChar: REChar; AIgnoreCase: boolean): boolean;
// Buffer contains AnsiChar pairs: (Kind, Data), where Kind is one of OpKind_ values,
// and Data depends on Kind
var
  OpKind: REChar;
  ch, ch2: REChar;
  N, i: integer;
begin
  if AIgnoreCase then
    AChar := _UpperCase(AChar);
  repeat
    OpKind := ABuffer^;
    case OpKind of
      OpKind_End:
        begin
          Result := False;
          Exit;
        end;

      OpKind_Range:
        begin
          Inc(ABuffer);
          ch := ABuffer^;
          Inc(ABuffer);
          ch2 := ABuffer^;
          Inc(ABuffer);
          {
          // if AIgnoreCase, ch, ch2 are upcased in opcode
          if AIgnoreCase then
          begin
            ch := _UpperCase(ch);
            ch2 := _UpperCase(ch2);
          end;
          }
          if (AChar >= ch) and (AChar <= ch2) then
          begin
            Result := True;
            Exit;
          end;
        end;

      OpKind_MetaClass:
        begin
          Inc(ABuffer);
          N := Ord(ABuffer^);
          Inc(ABuffer);
          if CharCheckers[N](AChar) then
          begin
            Result := True;
            Exit
          end;
        end;

      OpKind_Char:
        begin
          Inc(ABuffer);
          N := PLongInt(ABuffer)^;
          Inc(ABuffer, RENumberSz);
          for i := 1 to N do
          begin
            ch := ABuffer^;
            Inc(ABuffer);
            {
            // already upcased in opcode
            if AIgnoreCase then
              ch := _UpperCase(ch);
            }
            if ch = AChar then
            begin
              Result := True;
              Exit;
            end;
          end;
        end;

      {$IFDEF FastUnicodeData}
      OpKind_CategoryYes,
      OpKind_CategoryNo:
        begin
          Inc(ABuffer);
          ch := ABuffer^;
          Inc(ABuffer);
          ch2 := ABuffer^;
          Inc(ABuffer);
          Result := CheckCharCategory(AChar, ch, ch2);
          if OpKind = OpKind_CategoryNo then
            Result := not Result;
          if Result then
            Exit;
        end;
      {$ENDIF}

      else
        Error(reeBadOpcodeInCharClass);
    end;
  until False; // assume that Buffer is ended correctly
end;


procedure TRegExpr.GetCharSetFromWordChars(var ARes: TRegExprCharSet);
{$IFDEF UseWordChars}
var
  i: integer;
  ch: REChar;
{$ENDIF}
begin
  {$IFDEF UseWordChars}
  ARes := [];
  for i := 1 to Length(fWordChars) do
  begin
    ch := fWordChars[i];
    {$IFDEF UnicodeRE}
    if Ord(ch) <= $FF then
    {$ENDIF}
      Include(ARes, byte(ch));
  end;
  {$ELSE}
  ARes := RegExprWordSet;
  {$ENDIF}
end;

procedure TRegExpr.GetCharSetFromSpaceChars(var ARes: TRegExprCharset);
{$IFDEF UseSpaceChars}
var
  i: integer;
  ch: REChar;
{$ENDIF}
begin
  {$IFDEF UseSpaceChars}
  ARes := [];
  for i := 1 to Length(fSpaceChars) do
  begin
    ch := fSpaceChars[i];
    {$IFDEF UnicodeRE}
    if Ord(ch) <= $FF then
    {$ENDIF}
      Include(ARes, byte(ch));
  end;
  {$ELSE}
  ARes := RegExprSpaceSet;
  {$ENDIF}
end;

procedure TRegExpr.GetCharSetFromCharClass(ABuffer: PRegExprChar; AIgnoreCase: boolean; var ARes: TRegExprCharset);
var
  ch, ch2: REChar;
  TempSet: TRegExprCharSet;
  N, i: integer;
begin
  ARes := [];
  TempSet := [];
  repeat
    case ABuffer^ of
      OpKind_End:
        Exit;

      OpKind_Range:
        begin
          Inc(ABuffer);
          ch := ABuffer^;
          Inc(ABuffer);
          ch2 := ABuffer^;
          {$IFDEF UnicodeRE}
          if Ord(ch2) > $FF then
            ch2 := REChar($FF);
          {$ENDIF}
          Inc(ABuffer);
          for i := Ord(ch) to Ord(ch2) do
          begin
            Include(ARes, byte(i));
            if AIgnoreCase then
              Include(ARes, byte(InvertCase(REChar(i))));
          end;
        end;

      OpKind_MetaClass:
        begin
          Inc(ABuffer);
          N := Ord(ABuffer^);
          Inc(ABuffer);

          if N = CheckerIndex_Word then
          begin
            GetCharSetFromWordChars(TempSet);
            ARes := ARes + TempSet;
          end
          else
          if N = CheckerIndex_NotWord then
          begin
            GetCharSetFromWordChars(TempSet);
            ARes := ARes + (RegExprAllSet - TempSet);
          end
          else
          if N = CheckerIndex_Space then
          begin
            GetCharSetFromSpaceChars(TempSet);
            ARes := ARes + TempSet;
          end
          else
          if N = CheckerIndex_NotSpace then
          begin
            GetCharSetFromSpaceChars(TempSet);
            ARes := ARes + (RegExprAllSet - TempSet);
          end
          else
          if N = CheckerIndex_Digit then
            ARes := ARes + RegExprDigitSet
          else
          if N = CheckerIndex_NotDigit then
            ARes := ARes + (RegExprAllSet - RegExprDigitSet)
          else
          if N = CheckerIndex_VertSep then
            ARes := ARes + RegExprLineSeparatorsSet
          else
          if N = CheckerIndex_NotVertSep then
            ARes := ARes + (RegExprAllSet - RegExprLineSeparatorsSet)
          else
          if N = CheckerIndex_HorzSep then
            ARes := ARes + RegExprHorzSeparatorsSet
          else
          if N = CheckerIndex_NotHorzSep then
            ARes := ARes + (RegExprAllSet - RegExprHorzSeparatorsSet)
          else
          if N = CheckerIndex_LowerAZ then
          begin
            if AIgnoreCase then
              ARes := ARes + RegExprAllAzSet
            else
              ARes := ARes + RegExprLowerAzSet;
          end
          else
          if N = CheckerIndex_UpperAZ then
          begin
            if AIgnoreCase then
              ARes := ARes + RegExprAllAzSet
            else
              ARes := ARes + RegExprUpperAzSet;
          end
          else
            Error(reeBadOpcodeInCharClass);
        end;

      OpKind_Char:
        begin
          Inc(ABuffer);
          N := PLongInt(ABuffer)^;
          Inc(ABuffer, RENumberSz);
          for i := 1 to N do
          begin
            ch := ABuffer^;
            Inc(ABuffer);
            {$IFDEF UnicodeRE}
            if Ord(ch) <= $FF then
            {$ENDIF}
            begin
              Include(ARes, byte(ch));
              if AIgnoreCase then
                Include(ARes, byte(InvertCase(ch)));
            end;
          end;
        end;

      {$IFDEF FastUnicodeData}
      OpKind_CategoryYes,
      OpKind_CategoryNo:
        begin
          // usage of FirstCharSet makes no sense for regex with \p \P
          ARes := RegExprAllSet;
          Exit;
        end;
      {$ENDIF}

      else
        Error(reeBadOpcodeInCharClass);
    end;
  until False; // assume that Buffer is ended correctly
end;


function TRegExpr.GetModifierG: boolean;
begin
  Result := fModifiers.G;
end;

function TRegExpr.GetModifierI: boolean;
begin
  Result := fModifiers.I;
end;

function TRegExpr.GetModifierM: boolean;
begin
  Result := fModifiers.M;
end;

function TRegExpr.GetModifierR: boolean;
begin
  Result := fModifiers.R;
end;

function TRegExpr.GetModifierS: boolean;
begin
  Result := fModifiers.S;
end;

function TRegExpr.GetModifierX: boolean;
begin
  Result := fModifiers.X;
end;

function TRegExpr.CompileRegExpr(ARegExp: PRegExprChar): boolean;
// Compile a regular expression into internal code
// We can't allocate space until we know how big the compiled form will be,
// but we can't compile it (and thus know how big it is) until we've got a
// place to put the code. So we cheat: we compile it twice, once with code
// generation turned off and size counting turned on, and once "for real".
// This also means that we don't allocate space until we are sure that the
// thing really will compile successfully, and we never have to move the
// code and thus invalidate pointers into it. (Note that it has to be in
// one piece because free() must be able to free it all.)
// Beware that the optimization-preparation code in here knows about some
// of the structure of the compiled regexp.
var
  scan, longest, longestTemp: PRegExprChar;
  Len, LenTemp: integer;
  FlagTemp: integer;
begin
  Result := False;
  FlagTemp := 0;
  regParse := nil; // for correct error handling
  regExactlyLen := nil;

  ClearInternalIndexes;
  fLastError := reeOk;
  fLastErrorOpcode := TREOp(0);

  if Assigned(fHelper) then
    FreeAndNil(fHelper);
  fHelperLen := 0;

  try
    if programm <> nil then
    begin
      FreeMem(programm);
      programm := nil;
    end;

    if ARegExp = nil then
    begin
      Error(reeCompNullArgument);
      Exit;
    end;

    fProgModifiers := fModifiers;
    // well, may it's paranoia. I'll check it later.

    // First pass: calculate opcode size, validate regex
    fSecondPass := False;
    fCompModifiers := fModifiers;
    regParse := ARegExp;
    regNumBrackets := 1;
    regCodeSize := 0;
    regCode := @regDummy;
    regCodeWork := nil;
    regLookahead := False;
    regLookaheadNeg := False;
    regLookaheadGroup := -1;
    regLookbehind := False;

    EmitC(OP_MAGIC);
    if ParseReg(False, FlagTemp) = nil then
      Exit;

    // Allocate memory
    GetMem(programm, regCodeSize * SizeOf(REChar));

    // Second pass: emit opcode
    fSecondPass := True;
    fCompModifiers := fModifiers;
    regParse := ARegExp;
    regNumBrackets := 1;
    regCode := programm;
    regCodeWork := programm + REOpSz;

    EmitC(OP_MAGIC);
    if ParseReg(False, FlagTemp) = nil then
      Exit;

    // Dig out information for optimizations.
    {$IFDEF UseFirstCharSet} // ###0.929
    FirstCharSet := [];
    FillFirstCharSet(regCodeWork);
    for Len := 0 to 255 do
      FirstCharArray[Len] := byte(Len) in FirstCharSet;
    {$ENDIF}

    regAnchored := #0;
    regMust := nil;
    regMustLen := 0;
    regMustString := '';

    scan := regCodeWork; // First OP_BRANCH.
    if PREOp(regNext(scan))^ = OP_EEND then
    begin // Only one top-level choice.
      scan := scan + REOpSz + RENextOffSz;

      // Starting-point info.
      if PREOp(scan)^ = OP_BOL then
        Inc(regAnchored);

      // If there's something expensive in the r.e., find the longest
      // literal string that must appear and make it the regMust. Resolve
      // ties in favor of later strings, since the regstart check works
      // with the beginning of the r.e. and avoiding duplication
      // strengthens checking. Not a strong reason, but sufficient in the
      // absence of others.
      if (FlagTemp and FLAG_SPECSTART) <> 0 then
      begin
        longest := nil;
        Len := 0;
        while scan <> nil do
        begin
          if PREOp(scan)^ = OP_EXACTLY then
          begin
            longestTemp := scan + REOpSz + RENextOffSz + RENumberSz;
            LenTemp := PLongInt(scan + REOpSz + RENextOffSz)^;
            if LenTemp >= Len then
            begin
              longest := longestTemp;
              Len := LenTemp;
            end;
          end;
          scan := regNext(scan);
        end;
        regMust := longest;
        regMustLen := Len;
        if regMustLen > 1 then // don't use regMust if too short
          SetString(regMustString, regMust, regMustLen);
      end;
    end;

    Result := True;

  finally
    begin
      if not Result then
        InvalidateProgramm;
    end;
  end;

end; { of function TRegExpr.CompileRegExpr
  -------------------------------------------------------------- }

function TRegExpr.ParseReg(InBrackets: boolean; var FlagParse: integer): PRegExprChar;
// regular expression, i.e. main body or parenthesized thing
// Caller must absorb opening parenthesis.
// Combining parenthesis handling with the base level of regular expression
// is a trifle forced, but the need to tie the tails of the branches to what
// follows makes it hard to avoid.
var
  ret, br, ender: PRegExprChar;
  NBrackets: integer;
  FlagTemp: integer;
  SavedModifiers: TRegExprModifiers;
begin
  Result := nil;
  FlagTemp := 0;
  FlagParse := FLAG_HASWIDTH; // Tentatively.
  NBrackets := 0;
  SavedModifiers := fCompModifiers;

  // Make an OP_OPEN node, if parenthesized.
  if InBrackets then
  begin
    if regNumBrackets >= RegexMaxGroups then
    begin
      Error(reeCompParseRegTooManyBrackets);
      Exit;
    end;
    NBrackets := regNumBrackets;
    Inc(regNumBrackets);
    ret := EmitNode(TREOp(Ord(OP_OPEN) + NBrackets));
    GrpOpCodes[NBrackets] := ret;
  end
  else
    ret := nil;

  // Pick up the branches, linking them together.
  br := ParseBranch(FlagTemp);
  if br = nil then
  begin
    Result := nil;
    Exit;
  end;
  if ret <> nil then
    Tail(ret, br) // OP_OPEN -> first.
  else
    ret := br;
  if (FlagTemp and FLAG_HASWIDTH) = 0 then
    FlagParse := FlagParse and not FLAG_HASWIDTH;
  FlagParse := FlagParse or FlagTemp and FLAG_SPECSTART;
  while (regParse^ = '|') do
  begin
    Inc(regParse);
    br := ParseBranch(FlagTemp);
    if br = nil then
    begin
      Result := nil;
      Exit;
    end;
    Tail(ret, br); // OP_BRANCH -> OP_BRANCH.
    if (FlagTemp and FLAG_HASWIDTH) = 0 then
      FlagParse := FlagParse and not FLAG_HASWIDTH;
    FlagParse := FlagParse or FlagTemp and FLAG_SPECSTART;
  end;

  // Make a closing node, and hook it on the end.
  if InBrackets then
    ender := EmitNode(TREOp(Ord(OP_CLOSE) + NBrackets))
  else
    ender := EmitNode(OP_EEND);
  Tail(ret, ender);

  // Hook the tails of the branches to the closing node.
  br := ret;
  while br <> nil do
  begin
    OpTail(br, ender);
    br := regNext(br);
  end;

  // Check for proper termination.
  if InBrackets then
    if regParse^ <> ')' then
    begin
      Error(reeCompParseRegUnmatchedBrackets);
      Exit;
    end
    else
      Inc(regParse); // skip trailing ')'
  if (not InBrackets) and (regParse < fRegexEnd) then
  begin
    if regParse^ = ')' then
      Error(reeCompParseRegUnmatchedBrackets2)
    else
      Error(reeCompParseRegJunkOnEnd);
    Exit;
  end;
  fCompModifiers := SavedModifiers; // restore modifiers of parent
  Result := ret;
end; { of function TRegExpr.ParseReg
  -------------------------------------------------------------- }

function TRegExpr.ParseBranch(var FlagParse: integer): PRegExprChar;
// one alternative of an | operator
// Implements the concatenation operator.
var
  ret, chain, latest: PRegExprChar;
  FlagTemp: integer;
begin
  FlagTemp := 0;
  FlagParse := FLAG_WORST; // Tentatively.

  ret := EmitNode(OP_BRANCH);
  chain := nil;
  while (regParse < fRegexEnd) and (regParse^ <> '|') and (regParse^ <> ')') do
  begin
    latest := ParsePiece(FlagTemp);
    if latest = nil then
    begin
      Result := nil;
      Exit;
    end;
    FlagParse := FlagParse or FlagTemp and FLAG_HASWIDTH;
    if chain = nil // First piece.
    then
      FlagParse := FlagParse or FlagTemp and FLAG_SPECSTART
    else
      Tail(chain, latest);
    chain := latest;
  end;
  if chain = nil // Loop ran zero times.
  then
    EmitNode(OP_NOTHING);
  Result := ret;
end; { of function TRegExpr.ParseBranch
  -------------------------------------------------------------- }

function TRegExpr.ParsePiece(var FlagParse: integer): PRegExprChar;
// something followed by possible [*+?{]
// Note that the branching code sequences used for ? and the general cases
// of * and + and { are somewhat optimized:  they use the same OP_NOTHING node as
// both the endmarker for their branch list and the body of the last branch.
// It might seem that this node could be dispensed with entirely, but the
// endmarker role is not redundant.

  function ParseNumber(AStart, AEnd: PRegExprChar): TREBracesArg;
  begin
    Result := 0;
    if AEnd - AStart + 1 > 8 then
    begin // prevent stupid scanning
      Error(reeBRACESArgTooBig);
      Exit;
    end;
    while AStart <= AEnd do
    begin
      Result := Result * 10 + (Ord(AStart^) - Ord('0'));
      Inc(AStart);
    end;
    if (Result > MaxBracesArg) or (Result < 0) then
    begin
      Error(reeBRACESArgTooBig);
      Exit;
    end;
  end;

var
  TheOp: TREOp;
  NextNode: PRegExprChar;

  procedure EmitComplexBraces(ABracesMin, ABracesMax: TREBracesArg; ANonGreedyOp: boolean); // ###0.940
  {$IFDEF ComplexBraces}
  var
    off: TRENextOff;
  {$ENDIF}
  begin
    {$IFNDEF ComplexBraces}
    Error(reeComplexBracesNotImplemented);
    {$ELSE}
    if ANonGreedyOp then
      TheOp := OP_LOOPNG
    else
      TheOp := OP_LOOP;
    InsertOperator(OP_LOOPENTRY, Result, REOpSz + RENextOffSz);
    NextNode := EmitNode(TheOp);
    if regCode <> @regDummy then
    begin
      off := (Result + REOpSz + RENextOffSz) - (regCode - REOpSz - RENextOffSz);
      // back to Atom after OP_LOOPENTRY
      PREBracesArg(AlignToInt(regCode))^ := ABracesMin;
      Inc(regCode, REBracesArgSz);
      PREBracesArg(AlignToInt(regCode))^ := ABracesMax;
      Inc(regCode, REBracesArgSz);
      PRENextOff(AlignToPtr(regCode))^ := off;
      Inc(regCode, RENextOffSz);
      {$IFDEF DebugSynRegExpr}
      if regcode - programm > regsize then
        raise Exception.Create
          ('TRegExpr.ParsePiece.EmitComplexBraces buffer overrun');
      {$ENDIF}
    end
    else
      Inc(regCodeSize, REBracesArgSz * 2 + RENextOffSz);
    Tail(Result, NextNode); // OP_LOOPENTRY -> OP_LOOP
    if regCode <> @regDummy then
      Tail(Result + REOpSz + RENextOffSz, NextNode); // Atom -> OP_LOOP
    {$ENDIF}
  end;

  procedure EmitSimpleBraces(ABracesMin, ABracesMax: TREBracesArg; ANonGreedyOp, APossessive: boolean);
  begin
    if APossessive then
      TheOp := OP_BRACES_POSS
    else
    if ANonGreedyOp then
      TheOp := OP_BRACESNG
    else
      TheOp := OP_BRACES;
    InsertOperator(TheOp, Result, REOpSz + RENextOffSz + REBracesArgSz * 2);
    if regCode <> @regDummy then
    begin
      PREBracesArg(AlignToInt(Result + REOpSz + RENextOffSz))^ := ABracesMin;
      PREBracesArg(AlignToInt(Result + REOpSz + RENextOffSz + REBracesArgSz))^ := ABracesMax;
    end;
  end;

var
  op, nextch: REChar;
  NonGreedyOp, NonGreedyCh, PossessiveCh: boolean;
  FlagTemp: integer;
  BracesMin, BracesMax: TREBracesArg;
  p: PRegExprChar;
begin
  FlagTemp := 0;
  Result := ParseAtom(FlagTemp);
  if Result = nil then
    Exit;

  op := regParse^;
  if not ((op = '*') or (op = '+') or (op = '?') or (op = '{')) then
  begin
    FlagParse := FlagTemp;
    Exit;
  end;
  if ((FlagTemp and FLAG_HASWIDTH) = 0) and (op <> '?') then
  begin
    Error(reePlusStarOperandCouldBeEmpty);
    Exit;
  end;

  case op of
    '*':
      begin
        FlagParse := FLAG_WORST or FLAG_SPECSTART;
        nextch := (regParse + 1)^;
        PossessiveCh := nextch = '+';
        if PossessiveCh then
        begin
          NonGreedyCh := False;
          NonGreedyOp := False;
        end
        else
        begin
          NonGreedyCh := nextch = '?';
          NonGreedyOp := NonGreedyCh or not fCompModifiers.G;
        end;
        if (FlagTemp and FLAG_SIMPLE) = 0 then
        begin
          if NonGreedyOp then
            EmitComplexBraces(0, MaxBracesArg, NonGreedyOp)
          else
          begin // Emit x* as (x&|), where & means "self".
            InsertOperator(OP_BRANCH, Result, REOpSz + RENextOffSz); // Either x
            OpTail(Result, EmitNode(OP_BACK)); // and loop
            OpTail(Result, Result); // back
            Tail(Result, EmitNode(OP_BRANCH)); // or
            Tail(Result, EmitNode(OP_NOTHING)); // nil.
          end
        end
        else
        begin // Simple
          if PossessiveCh then
            TheOp := OP_STAR_POSS
          else
          if NonGreedyOp then
            TheOp := OP_STARNG
          else
            TheOp := OP_STAR;
          InsertOperator(TheOp, Result, REOpSz + RENextOffSz);
        end;
        if NonGreedyCh or PossessiveCh then
          Inc(regParse); // Skip extra AnsiChar ('?')
      end; { of case '*' }
    '+':
      begin
        FlagParse := FLAG_WORST or FLAG_SPECSTART or FLAG_HASWIDTH;
        nextch := (regParse + 1)^;
        PossessiveCh := nextch = '+';
        if PossessiveCh then
        begin
          NonGreedyCh := False;
          NonGreedyOp := False;
        end
        else
        begin
          NonGreedyCh := nextch = '?';
          NonGreedyOp := NonGreedyCh or not fCompModifiers.G;
        end;
        if (FlagTemp and FLAG_SIMPLE) = 0 then
        begin
          if NonGreedyOp then
            EmitComplexBraces(1, MaxBracesArg, NonGreedyOp)
          else
          begin // Emit x+ as x(&|), where & means "self".
            NextNode := EmitNode(OP_BRANCH); // Either
            Tail(Result, NextNode);
            Tail(EmitNode(OP_BACK), Result); // loop back
            Tail(NextNode, EmitNode(OP_BRANCH)); // or
            Tail(Result, EmitNode(OP_NOTHING)); // nil.
          end
        end
        else
        begin // Simple
          if PossessiveCh then
            TheOp := OP_PLUS_POSS
          else
          if NonGreedyOp then
            TheOp := OP_PLUSNG
          else
            TheOp := OP_PLUS;
          InsertOperator(TheOp, Result, REOpSz + RENextOffSz);
        end;
        if NonGreedyCh or PossessiveCh then
          Inc(regParse); // Skip extra AnsiChar ('?')
      end; { of case '+' }
    '?':
      begin
        FlagParse := FLAG_WORST;
        nextch := (regParse + 1)^;
        PossessiveCh := nextch = '+';
        if PossessiveCh then
        begin
          NonGreedyCh := False;
          NonGreedyOp := False;
        end
        else
        begin
          NonGreedyCh := nextch = '?';
          NonGreedyOp := NonGreedyCh or not fCompModifiers.G;
        end;
        if NonGreedyOp or PossessiveCh then
        begin // ###0.940  // We emit x?? as x{0,1}?
          if (FlagTemp and FLAG_SIMPLE) = 0 then
          begin
            if PossessiveCh then
              Error(reePossessiveAfterComplexBraces);
            EmitComplexBraces(0, 1, NonGreedyOp);
          end
          else
            EmitSimpleBraces(0, 1, NonGreedyOp, PossessiveCh);
        end
        else
        begin // greedy '?'
          InsertOperator(OP_BRANCH, Result, REOpSz + RENextOffSz); // Either x
          Tail(Result, EmitNode(OP_BRANCH)); // or
          NextNode := EmitNode(OP_NOTHING); // nil.
          Tail(Result, NextNode);
          OpTail(Result, NextNode);
        end;
        if NonGreedyCh or PossessiveCh then
          Inc(regParse); // Skip extra AnsiChar ('?')
      end; { of case '?' }
    '{':
      begin
        Inc(regParse);
        p := regParse;
        while IsDigitChar(regParse^) do // <min> MUST appear
          Inc(regParse);
        if (regParse^ <> '}') and (regParse^ <> ',') or (p = regParse) then
        begin
          Error(reeIncorrectBraces);
          Exit;
        end;
        BracesMin := ParseNumber(p, regParse - 1);
        if regParse^ = ',' then
        begin
          Inc(regParse);
          p := regParse;
          while IsDigitChar(regParse^) do
            Inc(regParse);
          if regParse^ <> '}' then
          begin
            Error(reeIncorrectBraces);
            Exit;
          end;
          if p = regParse then
            BracesMax := MaxBracesArg
          else
            BracesMax := ParseNumber(p, regParse - 1);
        end
        else
          BracesMax := BracesMin; // {n} == {n,n}
        if BracesMin > BracesMax then
        begin
          Error(reeBracesMinParamGreaterMax);
          Exit;
        end;
        if BracesMin > 0 then
          FlagParse := FLAG_WORST;
        if BracesMax > 0 then
          FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SPECSTART;

        nextch := (regParse + 1)^;
        PossessiveCh := nextch = '+';
        if PossessiveCh then
        begin
          NonGreedyCh := False;
          NonGreedyOp := False;
        end
        else
        begin
          NonGreedyCh := nextch = '?';
          NonGreedyOp := NonGreedyCh or not fCompModifiers.G;
        end;
        if (FlagTemp and FLAG_SIMPLE) <> 0 then
          EmitSimpleBraces(BracesMin, BracesMax, NonGreedyOp, PossessiveCh)
        else
        begin
          if PossessiveCh then
            Error(reePossessiveAfterComplexBraces);
          EmitComplexBraces(BracesMin, BracesMax, NonGreedyOp);
        end;
        if NonGreedyCh or PossessiveCh then
          Inc(regParse); // Skip extra AnsiChar '?'
      end; // of case '{'
    // else // here we can't be
  end; { of case op }

  Inc(regParse);
  op := regParse^;
  if (op = '*') or (op = '+') or (op = '?') or (op = '{') then
    Error(reeNestedQuantif);
end; { of function TRegExpr.ParsePiece
  -------------------------------------------------------------- }

function TRegExpr.HexDig(Ch: REChar): integer;
begin
  case Ch of
    '0' .. '9':
      Result := Ord(Ch) - Ord('0');
    'a' .. 'f':
      Result := Ord(Ch) - Ord('a') + 10;
    'A' .. 'F':
      Result := Ord(Ch) - Ord('A') + 10;
    else
      begin
        Result := 0;
        Error(reeBadHexDigit);
      end;
  end;
end;

function TRegExpr.UnQuoteChar(var APtr, AEnd: PRegExprChar): REChar;
var
  Ch: REChar;
begin
  case APtr^ of
    't':
      Result := #$9; // \t => tab (HT/TAB)
    'n':
      Result := #$a; // \n => newline (NL)
    'r':
      Result := #$d; // \r => carriage return (CR)
    'f':
      Result := #$c; // \f => form feed (FF)
    'a':
      Result := #$7; // \a => alarm (bell) (BEL)
    'e':
      Result := #$1b; // \e => escape (ESC)
    'c':
      begin // \cK => code for Ctrl+K
        Result := #0;
        Inc(APtr);
        if APtr >= AEnd then
          Error(reeNoLetterAfterBSlashC);
        Ch := APtr^;
        case Ch of
          'a' .. 'z':
            Result := REChar(Ord(Ch) - Ord('a') + 1);
          'A' .. 'Z':
            Result := REChar(Ord(Ch) - Ord('A') + 1);
          else
            Error(reeNoLetterAfterBSlashC);
        end;
      end;
    'x':
      begin // \x: hex AnsiChar
        Result := #0;
        Inc(APtr);
        if APtr >= AEnd then
        begin
          Error(reeNoHexCodeAfterBSlashX);
          Exit;
        end;
        if APtr^ = '{' then
        begin // \x{nnnn} //###0.936
          repeat
            Inc(APtr);
            if APtr >= AEnd then
            begin
              Error(reeNoHexCodeAfterBSlashX);
              Exit;
            end;
            if APtr^ <> '}' then
            begin
              if (Ord(Result) ShR (SizeOf(REChar) * 8 - 4)) and $F <> 0 then
              begin
                Error(reeHexCodeAfterBSlashXTooBig);
                Exit;
              end;
              Result := REChar((Ord(Result) ShL 4) or HexDig(APtr^));
              // HexDig will cause Error if bad hex digit found
            end
            else
              Break;
          until False;
        end
        else
        begin
          Result := REChar(HexDig(APtr^));
          // HexDig will cause Error if bad hex digit found
          Inc(APtr);
          if APtr >= AEnd then
          begin
            Error(reeNoHexCodeAfterBSlashX);
            Exit;
          end;
          Result := REChar((Ord(Result) ShL 4) or HexDig(APtr^));
          // HexDig will cause Error if bad hex digit found
        end;
      end;
  else
    begin
      Result := APtr^;
      if (Result <> '_') and IsWordChar(Result) then
      begin
        fLastErrorSymbol := Result;
        Error(reeUnknownMetaSymbol);
      end;
    end;
  end;
end;

function TRegExpr.ParseAtom(var FlagParse: integer): PRegExprChar;
// the lowest level
// Optimization:  gobbles an entire sequence of ordinary characters so that
// it can turn them into a single node, which is smaller to store and
// faster to run. Backslashed characters are exceptions, each becoming a
// separate node; the code is simpler that way and it's not worth fixing.
var
  ret: PRegExprChar;
  RangeBeg, RangeEnd: REChar;
  CanBeRange: boolean;
  AddrOfLen: PLongInt;

  procedure EmitExactly(Ch: REChar);
  begin
    if fCompModifiers.I then
      ret := EmitNode(OP_EXACTLYCI)
    else
      ret := EmitNode(OP_EXACTLY);
    EmitInt(1);
    EmitC(Ch);
    FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
  end;

  procedure EmitRangeChar(Ch: REChar; AStartOfRange: boolean);
  begin
    CanBeRange := AStartOfRange;
    if fCompModifiers.I then
      Ch := _UpperCase(Ch);
    if AStartOfRange then
    begin
      AddrOfLen := nil;
      RangeBeg := Ch;
    end
    else
    begin
      if AddrOfLen = nil then
      begin
        EmitC(OpKind_Char);
        Pointer(AddrOfLen) := regCode;
        EmitInt(0);
      end;
      Inc(AddrOfLen^);
      EmitC(Ch);
    end;
  end;

  procedure EmitRangePacked(ch1, ch2: REChar);
  var
    ChkIndex: integer;
  begin
    AddrOfLen := nil;
    CanBeRange := False;

    if fCompModifiers.I then
    begin
      ch1 := _UpperCase(ch1);
      ch2 := _UpperCase(ch2);
    end;

    for ChkIndex := Low(CharCheckerInfos) to High(CharCheckerInfos) do
      if (CharCheckerInfos[ChkIndex].CharBegin = ch1) and
        (CharCheckerInfos[ChkIndex].CharEnd = ch2) then
      begin
        EmitC(OpKind_MetaClass);
        EmitC(REChar(CharCheckerInfos[ChkIndex].CheckerIndex));
        Exit;
      end;

    EmitC(OpKind_Range);
    EmitC(ch1);
    EmitC(ch2);
  end;

  {$IFDEF FastUnicodeData}
  procedure EmitCategoryInCharClass(APositive: boolean);
  var
    ch, ch2: REChar;
  begin
    AddrOfLen := nil;
    CanBeRange := False;
    Inc(regParse);
    FindCategoryName(regParse, ch, ch2);
    if APositive then
      EmitC(OpKind_CategoryYes)
    else
      EmitC(OpKind_CategoryNo);
    EmitC(ch);
    EmitC(ch2);
  end;
  {$ENDIF}

var
  FlagTemp: integer;
  Len: integer;
  SavedPtr: PRegExprChar;
  EnderChar, TempChar: REChar;
  DashForRange: Boolean;
  GrpKind: TREGroupKind;
  GrpName: RegExprString;
  GrpIndex: integer;
  NextCh: REChar;
begin
  Result := nil;
  FlagTemp := 0;
  FlagParse := FLAG_WORST;
  AddrOfLen := nil;
  GrpIndex := -1;

  Inc(regParse);
  case (regParse - 1)^ of
    '^':
     begin
      if not fCompModifiers.M
        {$IFDEF UseLineSep} or (fLineSeparators = '') {$ENDIF} then
        ret := EmitNode(OP_BOL)
      else
        ret := EmitNode(OP_BOLML);
     end;

    '$':
     begin
      if not fCompModifiers.M
        {$IFDEF UseLineSep} or (fLineSeparators = '') {$ENDIF} then
        ret := EmitNode(OP_EOL)
      else
        ret := EmitNode(OP_EOLML);
     end;

    '.':
     begin
      if fCompModifiers.S then
      begin
        ret := EmitNode(OP_ANY);
        FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
      end
      else
      begin // not /s, so emit [^:LineSeparators:]
        ret := EmitNode(OP_ANYML);
        FlagParse := FlagParse or FLAG_HASWIDTH; // not so simple ;)
      end;
     end;

    '[':
      begin
        if regParse^ = '^' then
        begin // Complement of range.
          if fCompModifiers.I then
            ret := EmitNode(OP_ANYBUTCI)
          else
            ret := EmitNode(OP_ANYBUT);
          Inc(regParse);
        end
        else if fCompModifiers.I then
          ret := EmitNode(OP_ANYOFCI)
        else
          ret := EmitNode(OP_ANYOF);

        CanBeRange := False;

        if regParse^ = ']' then
        begin
          // first ']' inside [] treated as simple AnsiChar, no need to check '['
          EmitRangeChar(regParse^, (regParse + 1)^ = '-');
          Inc(regParse);
        end;

        while (regParse < fRegexEnd) and (regParse^ <> ']') do
        begin
          // last '-' inside [] treated as simple dash
          if (regParse^ = '-') and
            ((regParse + 1) < fRegexEnd) and
            ((regParse + 1)^ = ']') then
          begin
            EmitRangeChar('-', False);
            Inc(regParse);
            Break;
          end;

          // AnsiChar '-' which (maybe) makes a range
          if (regParse^ = '-') and ((regParse + 1) < fRegexEnd) and CanBeRange then
          begin
            Inc(regParse);
            RangeEnd := regParse^;
            if RangeEnd = EscChar then
            begin
              if _IsMetaChar((regParse + 1)^) then
              begin
                Error(reeMetaCharAfterMinusInRange);
                Exit;
              end;
              Inc(regParse);
              RangeEnd := UnQuoteChar(regParse, fRegexEnd);
            end;

            // special handling for Russian range a-YA, add 2 ranges: a-ya and A-YA
            if fCompModifiers.R and
              (RangeBeg = RusRangeLoLow) and (RangeEnd = RusRangeHiHigh) then
            begin
              EmitRangePacked(RusRangeLoLow, RusRangeLoHigh);
              EmitRangePacked(RusRangeHiLow, RusRangeHiHigh);
            end
            else
            begin // standard r.e. handling
              if RangeBeg > RangeEnd then
              begin
                Error(reeInvalidRange);
                Exit;
              end;
              EmitRangePacked(RangeBeg, RangeEnd);
            end;
            Inc(regParse);
          end
          else
          begin
            if regParse^ = EscChar then
            begin
              Inc(regParse);
              if regParse >= fRegexEnd then
              begin
                Error(reeParseAtomTrailingBackSlash);
                Exit;
              end;
              if _IsMetaChar(regParse^) then
              begin
                AddrOfLen := nil;
                CanBeRange := False;
                EmitC(OpKind_MetaClass);
                case regParse^ of
                  'w':
                    EmitC(REChar(CheckerIndex_Word));
                  'W':
                    EmitC(REChar(CheckerIndex_NotWord));
                  's':
                    EmitC(REChar(CheckerIndex_Space));
                  'S':
                    EmitC(REChar(CheckerIndex_NotSpace));
                  'd':
                    EmitC(REChar(CheckerIndex_Digit));
                  'D':
                    EmitC(REChar(CheckerIndex_NotDigit));
                  'v':
                    EmitC(REChar(CheckerIndex_VertSep));
                  'V':
                    EmitC(REChar(CheckerIndex_NotVertSep));
                  'h':
                    EmitC(REChar(CheckerIndex_HorzSep));
                  'H':
                    EmitC(REChar(CheckerIndex_NotHorzSep));
                  else
                    Error(reeBadOpcodeInCharClass);
                end;
              end
              else
              {$IFDEF FastUnicodeData}
              if regParse^ = 'p' then
                EmitCategoryInCharClass(True)
              else
              if regParse^ = 'P' then
                EmitCategoryInCharClass(False)
              else
              {$ENDIF}
              begin
                TempChar := UnQuoteChar(regParse, fRegexEnd);
                // False if '-' is last AnsiChar in []
                DashForRange :=
                  (regParse + 2 < fRegexEnd) and
                  ((regParse + 1)^ = '-') and
                  ((regParse + 2)^ <> ']');
                EmitRangeChar(TempChar, DashForRange);
              end;
            end
            else
            begin
              // False if '-' is last AnsiChar in []
              DashForRange :=
                (regParse + 2 < fRegexEnd) and
                ((regParse + 1)^ = '-') and
                ((regParse + 2)^ <> ']');
              EmitRangeChar(regParse^, DashForRange);
            end;
            Inc(regParse);
          end;
        end; { of while }
        AddrOfLen := nil;
        CanBeRange := False;
        EmitC(OpKind_End);
        if regParse^ <> ']' then
        begin
          Error(reeUnmatchedSqBrackets);
          Exit;
        end;
        Inc(regParse);
        FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
      end;

    '(':
      begin
        GrpKind := gkNormalGroup;
        GrpName := '';

        // A: detect kind of expression in brackets
        if regParse^ = '?' then
        begin
          NextCh := (regParse + 1)^;
          case NextCh of
            ':':
              begin
                // non-capturing group: (?:regex)
                GrpKind := gkNonCapturingGroup;
                Inc(regParse, 2);
              end;
            '>':
              begin
                // atomic group: (?>regex)
                GrpKind := gkNonCapturingGroup;
                Inc(regParse, 2);
                GrpAtomic[regNumBrackets] := True;
              end;
            'P':
              begin
                if (regParse + 4 >= fRegexEnd) then
                  Error(reeNamedGroupBad);
                case (regParse + 2)^ of
                  '<':
                    begin
                      // named group: (?P<name>regex)
                      GrpKind := gkNormalGroup;
                      FindGroupName(regParse + 3, fRegexEnd, '>', GrpName);
                      Inc(regParse, Length(GrpName) + 4);
                    end;
                  '=':
                    begin
                      // back-reference to named group: (?P=name)
                      GrpKind := gkNamedGroupReference;
                      FindGroupName(regParse + 3, fRegexEnd, ')', GrpName);
                      Inc(regParse, Length(GrpName) + 4);
                    end;
                  '>':
                    begin
                      // subroutine call to named group: (?P>name)
                      GrpKind := gkSubCall;
                      FindGroupName(regParse + 3, fRegexEnd, ')', GrpName);
                      Inc(regParse, Length(GrpName) + 4);
                      GrpIndex := MatchIndexFromName(GrpName);
                      if GrpIndex < 1 then
                        Error(reeNamedGroupBadRef);
                    end;
                  else
                    Error(reeNamedGroupBad);
                end;
              end;
            '<':
              begin
                // lookbehind: (?<=foo)bar
                if (regParse + 4 >= fRegexEnd) then
                  Error(reeLookbehindBad);
                case (regParse + 2)^ of
                  '=':
                    begin
                      // allow lookbehind only at the beginning
                      if regParse <> fRegexStart + 1 then
                        Error(reeLookaroundNotAtEdge);

                      GrpKind := gkLookbehind;
                      GrpAtomic[regNumBrackets] := RegExprLookbehindIsAtomic;
                      regLookbehind := True;
                      Inc(regParse, 3);
                    end;

                  '!':
                    begin
                      // allow lookbehind only at the beginning
                      if regParse <> fRegexStart + 1 then
                        Error(reeLookaroundNotAtEdge);

                      GrpKind := gkLookbehindNeg;
                      Inc(regParse, 3);
                      SavedPtr := _FindClosingBracket(regParse, fRegexEnd);
                      if SavedPtr = nil then
                        Error(reeCompParseRegUnmatchedBrackets);

                      // for '(?<!foo)bar', we make our regex 'bar' and make Helper object with 'foo'
                      if not fSecondPass then
                      begin
                        Len := SavedPtr - fRegexStart - 4;
                        if Len = 0 then
                          Error(reeLookbehindBad);

                        if fHelper = nil then
                          fHelper := TRegExpr.Create;
                        fHelper.Expression := Copy(fExpression, 5, Len);

                        try
                          fHelper.Compile;
                        except
                          Len := fHelper.LastError;
                          FreeAndNil(fHelper);
                          Error(Len);
                        end;

                        if fHelper.IsFixedLength(TempChar, Len) then
                          fHelperLen := Len
                        else
                        begin
                          FreeAndNil(fHelper);
                          Error(reeLookbehindTooComplex);
                        end;
                      end;

                      // jump to closing bracket, don't make opcode for (?<!foo)
                      regParse := SavedPtr + 1;
                    end;
                  else
                    Error(reeLookbehindBad);
                end;
              end;
            '=', '!':
              begin
                // lookaheads: foo(?=bar) and foo(?!bar)
                if (regParse + 3 >= fRegexEnd) then
                  Error(reeLookaheadBad);
                regLookahead := True;
                regLookaheadGroup := regNumBrackets;
                if NextCh = '=' then
                begin
                  GrpKind := gkLookahead;
                end
                else
                begin
                  GrpKind := gkLookaheadNeg;
                  regLookaheadNeg := True;
                end;
                GrpAtomic[regNumBrackets] := RegExprLookaheadIsAtomic;

                // check that these brackets are last in regex
                SavedPtr := _FindClosingBracket(regParse + 1, fRegexEnd);
                if (SavedPtr <> fRegexEnd - 1) then
                  Error(reeLookaroundNotAtEdge);

                Inc(regParse, 2);
              end;
            '#':
              begin
                // (?#comment)
                GrpKind := gkComment;
                Inc(regParse, 2);
              end;
            'a'..'z', '-':
              begin
                // modifiers string like (?mxr)
                GrpKind := gkModifierString;
                Inc(regParse);
              end;
            'R', '0':
              begin
                // recursion (?R), (?0)
                GrpKind := gkRecursion;
                Inc(regParse, 2);
                if regParse^ <> ')' then
                  Error(reeBadRecursion);
                Inc(regParse);
              end;
            '1'..'9':
              begin
                // subroutine call (?1)..(?99)
                GrpKind := gkSubCall;
                GrpIndex := Ord(NextCh) - Ord('0');
                Inc(regParse, 2);
                // support 2-digit group numbers
                case regParse^ of
                  ')':
                    begin
                      Inc(regParse);
                    end;
                  '0'..'9':
                    begin
                      GrpIndex := GrpIndex * 10 + Ord(regParse^) - Ord('0');
                      if GrpIndex >= RegexMaxGroups then
                        Error(reeBadSubCall);
                      Inc(regParse);
                      if regParse^ <> ')' then
                        Error(reeBadSubCall);
                      Inc(regParse);
                    end
                  else
                    Error(reeBadRecursion);
                end;
              end;
            '''':
              begin
                // named group: (?'name'regex)
                if (regParse + 4 >= fRegexEnd) then
                  Error(reeNamedGroupBad);
                GrpKind := gkNormalGroup;
                FindGroupName(regParse + 2, fRegexEnd, '''', GrpName);
                Inc(regParse, Length(GrpName) + 3);
              end;
            '&':
              begin
                // subroutine call to named group: (?&name)
                if (regParse + 2 >= fRegexEnd) then
                  Error(reeBadSubCall);
                GrpKind := gkSubCall;
                FindGroupName(regParse + 2, fRegexEnd, ')', GrpName);
                Inc(regParse, Length(GrpName) + 3);
                GrpIndex := MatchIndexFromName(GrpName);
                if GrpIndex < 1 then
                  Error(reeNamedGroupBadRef);
              end;
            else
              Error(reeIncorrectSpecialBrackets);
          end;
        end;

        // B: process found kind of brackets
        case GrpKind of
          gkNormalGroup,
          gkNonCapturingGroup,
          gkLookahead,
          gkLookaheadNeg,
          gkLookbehind:
            begin
              // skip this block for one of passes, to not double groups count;
              // must take first pass (we need GrpNames filled)
              if (GrpKind = gkNormalGroup) and not fSecondPass then
                if GrpCount < RegexMaxGroups - 1 then
                begin
                  Inc(GrpCount);
                  GrpIndexes[GrpCount] := regNumBrackets;
                  if GrpName <> '' then
                  begin
                    if MatchIndexFromName(GrpName) >= 0 then
                      Error(reeNamedGroupDupName);
                    GrpNames[GrpCount] := GrpName;
                  end;
                end;
              ret := ParseReg(True, FlagTemp);
              if ret = nil then
              begin
                Result := nil;
                Exit;
              end;
              FlagParse := FlagParse or FlagTemp and (FLAG_HASWIDTH or FLAG_SPECSTART);
            end;

          gkLookbehindNeg:
            begin
              // don't make opcode
              ret := EmitNode(OP_COMMENT);
              FlagParse := FLAG_WORST;
            end;

          gkNamedGroupReference:
            begin
              Len := MatchIndexFromName(GrpName);
              if Len < 0 then
                Error(reeNamedGroupBadRef);
              ret := EmitGroupRef(Len, fCompModifiers.I);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;

          gkModifierString:
            begin
              SavedPtr := regParse;
              while (regParse < fRegexEnd) and (regParse^ <> ')') do
                Inc(regParse);
              if (regParse^ <> ')') or
                not ParseModifiers(SavedPtr, regParse - SavedPtr, fCompModifiers) then
              begin
                Error(reeUnrecognizedModifier);
                Exit;
              end;
              Inc(regParse); // skip ')'
              ret := EmitNode(OP_COMMENT); // comment
              // Error (reeQuantifFollowsNothing);
              // Exit;
            end;

          gkComment:
            begin
              while (regParse < fRegexEnd) and (regParse^ <> ')') do
                Inc(regParse);
              if regParse^ <> ')' then
              begin
                Error(reeUnclosedComment);
                Exit;
              end;
              Inc(regParse); // skip ')'
              ret := EmitNode(OP_COMMENT); // comment
            end;

          gkRecursion:
            begin
              // set FLAG_HASWIDTH to allow compiling of such regex: b(?:m|(?R))*e
              FlagParse := FlagParse or FLAG_HASWIDTH;
              ret := EmitNode(OP_RECUR);
            end;

          gkSubCall:
            begin
              // set FLAG_HASWIDTH like for (?R)
              FlagParse := FlagParse or FLAG_HASWIDTH;
              ret := EmitNode(TReOp(Ord(OP_SUBCALL) + GrpIndex));
            end;
        end; // case GrpKind of
      end;

    '|', ')':
      begin // Supposed to be caught earlier.
        Error(reeInternalUrp);
        Exit;
      end;

    '?', '+', '*':
      begin
        Error(reeQuantifFollowsNothing);
        Exit;
      end;

    EscChar:
      begin
        if regParse >= fRegexEnd then
        begin
          Error(reeTrailingBackSlash);
          Exit;
        end;
        case regParse^ of
          'b':
            ret := EmitNode(OP_BOUND);
          'B':
            ret := EmitNode(OP_NOTBOUND);
          'A':
            ret := EmitNode(OP_BOL);
          'z':
            ret := EmitNode(OP_EOL);
          'Z':
            ret := EmitNode(OP_EOL2);
          'd':
            begin // r.e.extension - any digit ('0' .. '9')
              ret := EmitNode(OP_ANYDIGIT);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          'D':
            begin // r.e.extension - not digit ('0' .. '9')
              ret := EmitNode(OP_NOTDIGIT);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          's':
            begin // r.e.extension - any space AnsiChar
              ret := EmitNode(OP_ANYSPACE);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          'S':
            begin // r.e.extension - not space AnsiChar
              ret := EmitNode(OP_NOTSPACE);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          'w':
            begin // r.e.extension - any english AnsiChar / digit / '_'
              ret := EmitNode(OP_ANYLETTER);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          'W':
            begin // r.e.extension - not english AnsiChar / digit / '_'
              ret := EmitNode(OP_NOTLETTER);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          'v':
            begin
              ret := EmitNode(OP_ANYVERTSEP);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          'V':
            begin
              ret := EmitNode(OP_NOTVERTSEP);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          'h':
            begin
              ret := EmitNode(OP_ANYHORZSEP);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          'H':
            begin
              ret := EmitNode(OP_NOTHORZSEP);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          '1' .. '9':
            begin
              ret := EmitGroupRef(Ord(regParse^) - Ord('0'), fCompModifiers.I);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          {$IFDEF FastUnicodeData}
          'p':
            begin
              ret := EmitCategoryMain(True);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          'P':
            begin
              ret := EmitCategoryMain(False);
              FlagParse := FlagParse or FLAG_HASWIDTH or FLAG_SIMPLE;
            end;
          {$ENDIF}
        else
          EmitExactly(UnQuoteChar(regParse, fRegexEnd));
        end; { of case }
        Inc(regParse);
      end;

  else
    begin
      Dec(regParse);
      if fCompModifiers.X and // check for eXtended syntax
        ((regParse^ = '#') or IsIgnoredChar(regParse^)) then
      begin // ###0.941 \x
        if regParse^ = '#' then
        begin // Skip eXtended comment
          // find comment terminator (group of \n and/or \r)
          while (regParse < fRegexEnd) and (regParse^ <> #$d) and
            (regParse^ <> #$a) do
            Inc(regParse);
          while (regParse^ = #$d) or (regParse^ = #$a)
          // skip comment terminator
            do
            Inc(regParse);
          // attempt to support different type of line separators
        end
        else
        begin // Skip the blanks!
          while IsIgnoredChar(regParse^) do
            Inc(regParse);
        end;
        ret := EmitNode(OP_COMMENT); // comment
      end
      else
      begin
        Len := FindSkippedMetaLen(regParse, fRegexEnd);
        if Len <= 0 then
          if regParse^ <> '{' then
          begin
            Error(reeRarseAtomInternalDisaster);
            Exit;
          end
          else
            Len := FindSkippedMetaLen(regParse + 1, fRegexEnd) + 1;
            // bad {n,m} - compile as EXACTLY
        EnderChar := (regParse + Len)^;
        if (Len > 1) and ((EnderChar = '*') or (EnderChar = '+') or (EnderChar = '?') or (EnderChar = '{')) then
          Dec(Len); // back off clear of ?+*{ operand.
        FlagParse := FlagParse or FLAG_HASWIDTH;
        if Len = 1 then
          FlagParse := FlagParse or FLAG_SIMPLE;
        if fCompModifiers.I then
          ret := EmitNode(OP_EXACTLYCI)
        else
          ret := EmitNode(OP_EXACTLY);
        EmitInt(0);
        while (Len > 0) and ((not fCompModifiers.X) or (regParse^ <> '#')) do
        begin
          if not fCompModifiers.X or not IsIgnoredChar(regParse^) then
          begin
            EmitC(regParse^);
            if regCode <> @regDummy then
              Inc(regExactlyLen^);
          end;
          Inc(regParse);
          Dec(Len);
        end;
      end; { of if not comment }
    end; { of case else }
  end; { of case }

  Result := ret;
end; { of function TRegExpr.ParseAtom
  -------------------------------------------------------------- }

function TRegExpr.GetCompilerErrorPos: PtrInt;
begin
  Result := 0;
  if (fRegexStart = nil) or (regParse = nil) then
    Exit; // not in compiling mode ?
  Result := regParse - fRegexStart;
end; { of function TRegExpr.GetCompilerErrorPos
  -------------------------------------------------------------- }

{ ============================================================= }
{ ===================== Matching section ====================== }
{ ============================================================= }

procedure TRegExpr.FindGroupName(APtr, AEndPtr: PRegExprChar; AEndChar: REChar; var AName: RegExprString);
// check that group name is valid identifier, started from non-digit
// this is to be like in Python regex
var
  P: PRegExprChar;
begin
  P := APtr;
  if IsDigitChar(P^) or not IsWordChar(P^) then
    Error(reeNamedGroupBadName);

  repeat
    if P >= AEndPtr then
      Error(reeNamedGroupBad);
    if P^ = AEndChar then
      Break;
    if not IsWordChar(P^) then
      Error(reeNamedGroupBadName);
    Inc(P);
  until False;

  SetString(AName, APtr, P-APtr);
end;

function TRegExpr.FindRepeated(p: PRegExprChar; AMax: integer): integer;
// repeatedly match something simple, report how many
// p: points to current opcode
var
  scan: PRegExprChar;
  opnd: PRegExprChar;
  TheMax: PtrInt; // PtrInt, gets diff of 2 pointers
  InvChar: REChar;
  CurStart, CurEnd: PRegExprChar;
  ArrayIndex: integer;
  {$IFDEF UnicodeEx}
  i: integer;
  {$ENDIF}
begin
  Result := 0;
  scan := regInput; // points into InputString
  opnd := p + REOpSz + RENextOffSz; // points to operand of opcode (after OP_nnn code)
  TheMax := fInputEnd - scan;
  if TheMax > AMax then
    TheMax := AMax;
  case PREOp(p)^ of
    OP_ANY:
      begin
        // note - OP_ANYML cannot be proceeded in FindRepeated because can skip
        // more than one AnsiChar at once
        {$IFDEF UnicodeEx}
        for i := 1 to TheMax do
          IncUnicode2(scan, Result);
        {$ELSE}
        Result := TheMax;
        Inc(scan, Result);
        {$ENDIF}
      end;

    OP_EXACTLY:
      begin // in opnd can be only ONE AnsiChar !!!
        {
        // Alexey: commented because of https://github.com/andgineer/TRegExpr/issues/145
        NLen := PLongInt(opnd)^;
        if TheMax > NLen then
          TheMax := NLen;
        }
        Inc(opnd, RENumberSz);
        while (Result < TheMax) and (opnd^ = scan^) do
        begin
          Inc(Result);
          Inc(scan);
        end;
      end;

    OP_EXACTLYCI:
      begin // in opnd can be only ONE AnsiChar !!!
        {
        // Alexey: commented because of https://github.com/andgineer/TRegExpr/issues/145
        NLen := PLongInt(opnd)^;
        if TheMax > NLen then
          TheMax := NLen;
        }
        Inc(opnd, RENumberSz);
        while (Result < TheMax) and (opnd^ = scan^) do
        begin // prevent unneeded InvertCase //###0.931
          Inc(Result);
          Inc(scan);
        end;
        if Result < TheMax then
        begin // ###0.931
          InvChar := InvertCase(opnd^); // store in register
          while (Result < TheMax) and ((opnd^ = scan^) or (InvChar = scan^)) do
          begin
            Inc(Result);
            Inc(scan);
          end;
        end;
      end;

    OP_BSUBEXP:
      begin // ###0.936
        ArrayIndex := GrpIndexes[Ord(opnd^)];
        if ArrayIndex < 0 then
          Exit;
        CurStart := GrpBounds[regRecursion].GrpStart[ArrayIndex];
        if CurStart = nil then
          Exit;
        CurEnd := GrpBounds[regRecursion].GrpEnd[ArrayIndex];
        if CurEnd = nil then
          Exit;
        repeat
          opnd := CurStart;
          while opnd < CurEnd do
          begin
            if (scan >= fInputEnd) or (scan^ <> opnd^) then
              Exit;
            Inc(scan);
            Inc(opnd);
          end;
          Inc(Result);
          regInput := scan;
        until Result >= AMax;
      end;

    OP_BSUBEXPCI:
      begin // ###0.936
        ArrayIndex := GrpIndexes[Ord(opnd^)];
        if ArrayIndex < 0 then
          Exit;
        CurStart := GrpBounds[regRecursion].GrpStart[ArrayIndex];
        if CurStart = nil then
          Exit;
        CurEnd := GrpBounds[regRecursion].GrpEnd[ArrayIndex];
        if CurEnd = nil then
          Exit;
        repeat
          opnd := CurStart;
          while opnd < CurEnd do
          begin
            if (scan >= fInputEnd) or
              ((scan^ <> opnd^) and (scan^ <> InvertCase(opnd^))) then
              Exit;
            Inc(scan);
            Inc(opnd);
          end;
          Inc(Result);
          regInput := scan;
        until Result >= AMax;
      end;

    OP_ANYDIGIT:
      while (Result < TheMax) and IsDigitChar(scan^) do
      begin
        Inc(Result);
        Inc(scan);
      end;

    OP_NOTDIGIT:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and not IsDigitChar(scan^) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and not IsDigitChar(scan^) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    OP_ANYLETTER:
      while (Result < TheMax) and IsWordChar(scan^) do // ###0.940
      begin
        Inc(Result);
        Inc(scan);
      end;

    OP_NOTLETTER:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and not IsWordChar(scan^) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and not IsWordChar(scan^) do // ###0.940
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    OP_ANYSPACE:
      while (Result < TheMax) and IsSpaceChar(scan^) do
      begin
        Inc(Result);
        Inc(scan);
      end;

    OP_NOTSPACE:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and not IsSpaceChar(scan^) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and not IsSpaceChar(scan^) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    OP_ANYVERTSEP:
      while (Result < TheMax) and IsVertLineSeparator(scan^) do
      begin
        Inc(Result);
        Inc(scan);
      end;

    OP_NOTVERTSEP:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and not IsVertLineSeparator(scan^) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and not IsVertLineSeparator(scan^) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    OP_ANYHORZSEP:
      while (Result < TheMax) and IsHorzSeparator(scan^) do
      begin
        Inc(Result);
        Inc(scan);
      end;

    OP_NOTHORZSEP:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and not IsHorzSeparator(scan^) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and not IsHorzSeparator(scan^) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    OP_ANYOF:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and FindInCharClass(opnd, scan^, False) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and FindInCharClass(opnd, scan^, False) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    OP_ANYBUT:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and not FindInCharClass(opnd, scan^, False) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and not FindInCharClass(opnd, scan^, False) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    OP_ANYOFCI:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and FindInCharClass(opnd, scan^, True) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and FindInCharClass(opnd, scan^, True) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    OP_ANYBUTCI:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and not FindInCharClass(opnd, scan^, True) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and not FindInCharClass(opnd, scan^, True) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    {$IFDEF FastUnicodeData}
    OP_ANYCATEGORY:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and MatchOneCharCategory(opnd, scan) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and MatchOneCharCategory(opnd, scan) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}

    OP_NOTCATEGORY:
      {$IFDEF UNICODEEX}
      begin
        i := 0;
        while (i < TheMax) and not MatchOneCharCategory(opnd, scan) do
        begin
          Inc(i);
          IncUnicode2(scan, Result);
        end;
      end;
      {$ELSE}
      while (Result < TheMax) and not MatchOneCharCategory(opnd, scan) do
      begin
        Inc(Result);
        Inc(scan);
      end;
      {$ENDIF}
    {$ENDIF}

  else
    begin // Oh dear. Called inappropriately.
      Result := 0;
      Error(reeRegRepeatCalledInappropriately);
      Exit;
    end;
  end; { of case }
  regInput := scan;
end; { of function TRegExpr.FindRepeated
  -------------------------------------------------------------- }

function TRegExpr.regNext(p: PRegExprChar): PRegExprChar;
// dig the "next" pointer out of a node
var
  offset: TRENextOff;
begin
  if p = @regDummy then
  begin
    Result := nil;
    Exit;
  end;
  offset := PRENextOff(AlignToPtr(p + REOpSz))^; // ###0.933 inlined NEXT
  if offset = 0 then
    Result := nil
  else
    Result := p + offset;
end; { of function TRegExpr.regNext
  -------------------------------------------------------------- }

function TRegExpr.MatchPrim(prog: PRegExprChar): boolean;
// recursively matching routine
// Conceptually the strategy is simple:  check to see whether the current
// node matches, call self recursively to see whether the rest matches,
// and then act accordingly. In practice we make some effort to avoid
// recursion, in particular by going through "ordinary" nodes (that don't
// need to know whether the rest of the match failed) by a loop instead of
// by recursion.

var
  scan: PRegExprChar; // current node
  next: PRegExprChar; // next node
  Len: PtrInt;
  opnd, opGrpEnd: PRegExprChar;
  no: integer;
  save: PRegExprChar;
  saveCurrentGrp: integer;
  nextch: REChar;
  BracesMin, BracesMax: integer;
  // we use integer instead of TREBracesArg to better support */+
  {$IFDEF ComplexBraces}
  SavedLoopStack: TRegExprLoopStack; // very bad for recursion
  SavedLoopStackIdx: integer;
  {$ENDIF}
  bound1, bound2: boolean;
  checkAtomicGroup: boolean;
begin
  Result := False;
  {
  // Alexey: not sure it's ok for long searches in big texts, so disabled
  if regNestedCalls > MaxRegexBackTracking then
    Exit;
  Inc(regNestedCalls);
  }

  scan := prog;
  while scan <> nil do
  begin
    Len := PRENextOff(AlignToPtr(scan + 1))^; // ###0.932 inlined regNext
    if Len = 0 then
      next := nil
    else
      next := scan + Len;

    case scan^ of
      OP_BOUND:
        begin
          bound1 := (regInput = fInputStart) or not IsWordChar((regInput - 1)^);
          bound2 := (regInput >= fInputEnd) or not IsWordChar(regInput^);
          if bound1 = bound2 then
            Exit;
        end;

      OP_NOTBOUND:
        begin
          bound1 := (regInput = fInputStart) or not IsWordChar((regInput - 1)^);
          bound2 := (regInput >= fInputEnd) or not IsWordChar(regInput^);
          if bound1 <> bound2 then
            Exit;
        end;

      OP_BOL:
        begin
          if regInput <> fInputStart then
            Exit;
        end;

      OP_EOL:
        begin
          // \z matches at the very end
          if regInput < fInputEnd then
            Exit;
        end;

      OP_EOL2:
        begin
          // \Z matches at the very and + before the final line-break (LF and CR LF)
          if regInput < fInputEnd then
          begin
            if (regInput = fInputEnd - 1) and (regInput^ = #10) then
              begin end
            else
            if (regInput = fInputEnd - 2) and (regInput^ = #13) and ((regInput + 1) ^ = #10) then
              begin end
            else
              Exit;
          end;
        end;

      OP_BOLML:
        if regInput > fInputStart then
        begin
          if ((regInput - 1) <= fInputStart) or
            not IsPairedBreak(regInput - 2) then
          begin
            // don't stop between paired separator
            if IsPairedBreak(regInput - 1) then
              Exit;
            if not IsCustomLineSeparator((regInput - 1)^) then
              Exit;
          end;
        end;

      OP_EOLML:
        if regInput < fInputEnd then
        begin
          if not IsPairedBreak(regInput) then
          begin
            // don't stop between paired separator
            if (regInput > fInputStart) and IsPairedBreak(regInput - 1) then
              Exit;
            if not IsCustomLineSeparator(regInput^) then
              Exit;
          end;
        end;

      OP_ANY:
        begin
          if regInput >= fInputEnd then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_ANYML:
        begin
          if (regInput >= fInputEnd) or
            IsPairedBreak(regInput) or
            IsCustomLineSeparator(regInput^)
          then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_ANYDIGIT:
        begin
          if (regInput >= fInputEnd) or not IsDigitChar(regInput^) then
            Exit;
          Inc(regInput);
        end;

      OP_NOTDIGIT:
        begin
          if (regInput >= fInputEnd) or IsDigitChar(regInput^) then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_ANYLETTER:
        begin
          if (regInput >= fInputEnd) or not IsWordChar(regInput^) then
            Exit;
          Inc(regInput);
        end;

      OP_NOTLETTER:
        begin
          if (regInput >= fInputEnd) or IsWordChar(regInput^) then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_ANYSPACE:
        begin
          if (regInput >= fInputEnd) or not IsSpaceChar(regInput^) then
            Exit;
          Inc(regInput);
        end;

      OP_NOTSPACE:
        begin
          if (regInput >= fInputEnd) or IsSpaceChar(regInput^) then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_ANYVERTSEP:
        begin
          if (regInput >= fInputEnd) or not IsVertLineSeparator(regInput^) then
            Exit;
          Inc(regInput);
        end;

      OP_NOTVERTSEP:
        begin
          if (regInput >= fInputEnd) or IsVertLineSeparator(regInput^) then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_ANYHORZSEP:
        begin
          if (regInput >= fInputEnd) or not IsHorzSeparator(regInput^) then
            Exit;
          Inc(regInput);
        end;

      OP_NOTHORZSEP:
        begin
          if (regInput >= fInputEnd) or IsHorzSeparator(regInput^) then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_EXACTLYCI:
        begin
          opnd := scan + REOpSz + RENextOffSz; // OPERAND
          Len := PLongInt(opnd)^;
          Inc(opnd, RENumberSz);
          // Inline the first character, for speed.
          if (opnd^ <> regInput^) and (InvertCase(opnd^) <> regInput^) then
            Exit;
          // ###0.929 begin
          no := Len;
          save := regInput;
          while no > 1 do
          begin
            Inc(save);
            Inc(opnd);
            if (opnd^ <> save^) and (InvertCase(opnd^) <> save^) then
              Exit;
            Dec(no);
          end;
          // ###0.929 end
          Inc(regInput, Len);
        end;

      OP_EXACTLY:
        begin
          opnd := scan + REOpSz + RENextOffSz; // OPERAND
          Len := PLongInt(opnd)^;
          Inc(opnd, RENumberSz);
          // Inline the first character, for speed.
          if opnd^ <> regInput^ then
            Exit;
          // ###0.929 begin
          no := Len;
          save := regInput;
          while no > 1 do
          begin
            Inc(save);
            Inc(opnd);
            if opnd^ <> save^ then
              Exit;
            Dec(no);
          end;
          // ###0.929 end
          Inc(regInput, Len);
        end;

      OP_BSUBEXP:
        begin // ###0.936
          no := Ord((scan + REOpSz + RENextOffSz)^);
          no := GrpIndexes[no];
          if no < 0 then
            Exit;
          opnd := GrpBounds[regRecursion].GrpStart[no];
          if opnd = nil then
            Exit;
          opGrpEnd := GrpBounds[regRecursion].GrpEnd[no];
          if opGrpEnd = nil then
            Exit;
          save := regInput;
          while opnd < opGrpEnd do
          begin
            if (save >= fInputEnd) or (save^ <> opnd^) then
              Exit;
            Inc(save);
            Inc(opnd);
          end;
          regInput := save;
        end;

      OP_BSUBEXPCI:
        begin // ###0.936
          no := Ord((scan + REOpSz + RENextOffSz)^);
          no := GrpIndexes[no];
          if no < 0 then
            Exit;
          opnd := GrpBounds[regRecursion].GrpStart[no];
          if opnd = nil then
            Exit;
          opGrpEnd := GrpBounds[regRecursion].GrpEnd[no];
          if opGrpEnd = nil then
            Exit;
          save := regInput;
          while opnd < opGrpEnd do
          begin
            if (save >= fInputEnd) or
              ((save^ <> opnd^) and (save^ <> InvertCase(opnd^))) then
              Exit;
            Inc(save);
            Inc(opnd);
          end;
          regInput := save;
        end;

      OP_ANYOF:
        begin
          if (regInput >= fInputEnd) or
            not FindInCharClass(scan + REOpSz + RENextOffSz, regInput^, False) then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_ANYBUT:
        begin
          if (regInput >= fInputEnd) or
            FindInCharClass(scan + REOpSz + RENextOffSz, regInput^, False) then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_ANYOFCI:
        begin
          if (regInput >= fInputEnd) or
            not FindInCharClass(scan + REOpSz + RENextOffSz, regInput^, True) then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_ANYBUTCI:
        begin
          if (regInput >= fInputEnd) or
            FindInCharClass(scan + REOpSz + RENextOffSz, regInput^, True) then
            Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_NOTHING:
        ;
      OP_COMMENT:
        ;
      OP_BACK:
        ;

      OP_OPEN_FIRST .. OP_OPEN_LAST:
        begin
          no := Ord(scan^) - Ord(OP_OPEN);
          regCurrentGrp := no;
          save := GrpBounds[regRecursion].GrpStart[no];
          GrpBounds[regRecursion].GrpStart[no] := regInput;
          Result := MatchPrim(next);
          if not Result then
            GrpBounds[regRecursion].GrpStart[no] := save;
          // handle negative lookahead
          if regLookaheadNeg then
            if no = regLookaheadGroup then
            begin
              Result := not Result;
              if Result then
              begin
                // we need zero length of "lookahead group",
                // it is later used to adjust the match
                GrpBounds[regRecursion].GrpStart[no] := regInput;
                GrpBounds[regRecursion].GrpEnd[no]:= regInput;
              end
              else
                GrpBounds[regRecursion].GrpStart[no] := save;
            end;
          Exit;
        end;

      OP_CLOSE_FIRST .. OP_CLOSE_LAST:
        begin
          no := Ord(scan^) - Ord(OP_CLOSE);
          regCurrentGrp := -1;
          // handle atomic group, mark it as "done"
          // (we are here because some OP_BRANCH is matched)
          if GrpAtomic[no] then
            GrpAtomicDone[no] := True;
          save := GrpBounds[regRecursion].GrpEnd[no];
          GrpBounds[regRecursion].GrpEnd[no] := regInput;

          // if we are in OP_SUBCALL* call, it called OP_OPEN*, so we must return
          // in OP_CLOSE, without going to next opcode
          if GrpSubCalled[no] then
          begin
            Result := True;
            Exit;
          end;

          Result := MatchPrim(next);
          if not Result then // ###0.936
            GrpBounds[regRecursion].GrpEnd[no] := save;
          Exit;
        end;

      OP_BRANCH:
        begin
          saveCurrentGrp := regCurrentGrp;
          checkAtomicGroup := (regCurrentGrp >= 0) and GrpAtomic[regCurrentGrp];
          if (next^ <> OP_BRANCH) // No next choice in group
          then
            next := scan + REOpSz + RENextOffSz // Avoid recursion
          else
          begin
            repeat
              save := regInput;
              Result := MatchPrim(scan + REOpSz + RENextOffSz);
              regCurrentGrp := saveCurrentGrp;
              if Result then
                Exit;
              // if branch worked until OP_CLOSE, and marked atomic group as "done", then exit
              if checkAtomicGroup then
                if GrpAtomicDone[regCurrentGrp] then
                  Exit;
              regInput := save;
              scan := regNext(scan);
            until (scan = nil) or (scan^ <> OP_BRANCH);
            Exit;
          end;
        end;

      {$IFDEF ComplexBraces}
      OP_LOOPENTRY:
        begin // ###0.925
          no := LoopStackIdx;
          Inc(LoopStackIdx);
          if LoopStackIdx > LoopStackMax then
          begin
            Error(reeLoopStackExceeded);
            Exit;
          end;
          save := regInput;
          LoopStack[LoopStackIdx] := 0; // init loop counter
          Result := MatchPrim(next); // execute loop
          LoopStackIdx := no; // cleanup
          if Result then
            Exit;
          regInput := save;
          Exit;
        end;

      OP_LOOP, OP_LOOPNG:
        begin // ###0.940
          if LoopStackIdx <= 0 then
          begin
            Error(reeLoopWithoutEntry);
            Exit;
          end;
          opnd := scan + PRENextOff(AlignToPtr(scan + REOpSz + RENextOffSz + 2 * REBracesArgSz))^;
          BracesMin := PREBracesArg(AlignToInt(scan + REOpSz + RENextOffSz))^;
          BracesMax := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz + REBracesArgSz))^;
          save := regInput;
          if LoopStack[LoopStackIdx] >= BracesMin then
          begin // Min alredy matched - we can work
            if scan^ = OP_LOOP then
            begin
              // greedy way - first try to max deep of greed ;)
              if LoopStack[LoopStackIdx] < BracesMax then
              begin
                Inc(LoopStack[LoopStackIdx]);
                no := LoopStackIdx;
                Result := MatchPrim(opnd);
                LoopStackIdx := no;
                if Result then
                  Exit;
                regInput := save;
              end;
              Dec(LoopStackIdx); // Fail. May be we are too greedy? ;)
              Result := MatchPrim(next);
              if not Result then
                regInput := save;
              Exit;
            end
            else
            begin
              // non-greedy - try just now
              Result := MatchPrim(next);
              if Result then
                Exit
              else
                regInput := save; // failed - move next and try again
              if LoopStack[LoopStackIdx] < BracesMax then
              begin
                Inc(LoopStack[LoopStackIdx]);
                no := LoopStackIdx;
                Result := MatchPrim(opnd);
                LoopStackIdx := no;
                if Result then
                  Exit;
                regInput := save;
              end;
              Dec(LoopStackIdx); // Failed - back up
              Exit;
            end
          end
          else
          begin // first match a min_cnt times
            Inc(LoopStack[LoopStackIdx]);
            no := LoopStackIdx;
            Result := MatchPrim(opnd);
            LoopStackIdx := no;
            if Result then
              Exit;
            Dec(LoopStack[LoopStackIdx]);
            regInput := save;
            Exit;
          end;
        end;
      {$ENDIF}

      OP_STAR, OP_PLUS, OP_BRACES, OP_STARNG, OP_PLUSNG, OP_BRACESNG:
        begin
          // Lookahead to avoid useless match attempts when we know
          // what character comes next.
          nextch := #0;
          if next^ = OP_EXACTLY then
            nextch := (next + REOpSz + RENextOffSz + RENumberSz)^;
          BracesMax := MaxInt; // infinite loop for * and + //###0.92
          if (scan^ = OP_STAR) or (scan^ = OP_STARNG) then
            BracesMin := 0 // star
          else if (scan^ = OP_PLUS) or (scan^ = OP_PLUSNG) then
            BracesMin := 1 // plus
          else
          begin // braces
            BracesMin := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz))^;
            BracesMax := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz + REBracesArgSz))^;
          end;
          save := regInput;
          opnd := scan + REOpSz + RENextOffSz;
          if (scan^ = OP_BRACES) or (scan^ = OP_BRACESNG) then
            Inc(opnd, 2 * REBracesArgSz);

          if (scan^ = OP_PLUSNG) or (scan^ = OP_STARNG) or (scan^ = OP_BRACESNG) then
          begin
            // non-greedy mode
            BracesMax := FindRepeated(opnd, BracesMax);
            // don't repeat more than BracesMax
            // Now we know real Max limit to move forward (for recursion 'back up')
            // In some cases it can be faster to check only Min positions first,
            // but after that we have to check every position separtely instead
            // of fast scannig in loop.
            no := BracesMin;
            while no <= BracesMax do
            begin
              regInput := save + no;
              // If it could work, try it.
              if (nextch = #0) or (regInput^ = nextch) then
              begin
                {$IFDEF ComplexBraces}
                System.Move(LoopStack, SavedLoopStack, SizeOf(LoopStack));
                // ###0.925
                SavedLoopStackIdx := LoopStackIdx;
                {$ENDIF}
                if MatchPrim(next) then
                begin
                  Result := True;
                  Exit;
                end;
                {$IFDEF ComplexBraces}
                System.Move(SavedLoopStack, LoopStack, SizeOf(LoopStack));
                LoopStackIdx := SavedLoopStackIdx;
                {$ENDIF}
              end;
              Inc(no); // Couldn't or didn't - move forward.
            end; { of while }
            Exit;
          end
          else
          begin // greedy mode
            no := FindRepeated(opnd, BracesMax); // don't repeat more than max_cnt
            while no >= BracesMin do
            begin
              // If it could work, try it.
              if (nextch = #0) or (regInput^ = nextch) then
              begin
                {$IFDEF ComplexBraces}
                System.Move(LoopStack, SavedLoopStack, SizeOf(LoopStack));
                // ###0.925
                SavedLoopStackIdx := LoopStackIdx;
                {$ENDIF}
                if MatchPrim(next) then
                begin
                  Result := True;
                  Exit;
                end;
                {$IFDEF ComplexBraces}
                System.Move(SavedLoopStack, LoopStack, SizeOf(LoopStack));
                LoopStackIdx := SavedLoopStackIdx;
                {$ENDIF}
              end;
              Dec(no); // Couldn't or didn't - back up.
              regInput := save + no;
            end; { of while }
            Exit;
          end;
        end;

      OP_STAR_POSS, OP_PLUS_POSS, OP_BRACES_POSS:
        begin
          // Lookahead to avoid useless match attempts when we know
          // what character comes next.
          nextch := #0;
          if next^ = OP_EXACTLY then
            nextch := (next + REOpSz + RENextOffSz + RENumberSz)^;
          opnd := scan + REOpSz + RENextOffSz;
          case scan^ of
            OP_STAR_POSS:
              begin
                BracesMin := 0;
                BracesMax := MaxInt;
              end;
            OP_PLUS_POSS:
              begin
                BracesMin := 1;
                BracesMax := MaxInt;
              end;
            else
              begin // braces
                BracesMin := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz))^;
                BracesMax := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz + REBracesArgSz))^;
                Inc(opnd, 2 * REBracesArgSz);
              end;
          end;
          no := FindRepeated(opnd, BracesMax);
          if no >= BracesMin then
            if (nextch = #0) or (regInput^ = nextch) then
              Result := MatchPrim(next);
          Exit;
        end;

      OP_EEND:
        begin
          Result := True; // Success!
          Exit;
        end;

      {$IFDEF FastUnicodeData}
      OP_ANYCATEGORY:
        begin
          if (regInput >= fInputEnd) then Exit;
          if not MatchOneCharCategory(scan + REOpSz + RENextOffSz, regInput) then Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;

      OP_NOTCATEGORY:
        begin
          if (regInput >= fInputEnd) then Exit;
          if MatchOneCharCategory(scan + REOpSz + RENextOffSz, regInput) then Exit;
          {$IFDEF UNICODEEX}
          IncUnicode(regInput);
          {$ELSE}
          Inc(regInput);
          {$ENDIF}
        end;
      {$ENDIF}

      OP_RECUR:
        begin
          // call opcode start
          if regRecursion < RegexMaxRecursion then
          begin
            Inc(regRecursion);
            bound1 := MatchPrim(regCodeWork);
            Dec(regRecursion);
          end
          else
            bound1 := False;
          if not bound1 then Exit;
        end;

      OP_SUBCALL_FIRST .. OP_SUBCALL_LAST:
        begin
          // call subroutine
          no := GrpIndexes[Ord(scan^) - Ord(OP_SUBCALL)];
          if no < 0 then Exit;
          save := GrpOpCodes[no];
          if save = nil then Exit;
          if regRecursion < RegexMaxRecursion then
          begin
            // mark group in GrpSubCalled array so opcode can detect subcall
            checkAtomicGroup := GrpSubCalled[no];
            GrpSubCalled[no] := True;
            Inc(regRecursion);
            bound1 := MatchPrim(save);
            Dec(regRecursion);
            GrpSubCalled[no] := checkAtomicGroup;
          end
          else
            bound1 := False;
          if not bound1 then Exit;
        end;

    else
      begin
        Error(reeMatchPrimMemoryCorruption);
        Exit;
      end;
    end; { of case scan^ }
    scan := next;
  end; { of while scan <> nil }

  // We get here only if there's trouble -- normally "case EEND" is the
  // terminating point.
  Error(reeMatchPrimCorruptedPointers);
end; { of function TRegExpr.MatchPrim
  -------------------------------------------------------------- }

function TRegExpr.Exec(const AInputString: RegExprString): boolean;
begin
  InputString := AInputString;
  Result := ExecPrim(1, False, False, False);
end; { of function TRegExpr.Exec
  -------------------------------------------------------------- }

{$IFDEF OverMeth}
function TRegExpr.Exec: boolean;
var
  SlowChecks: boolean;
begin
  SlowChecks := Length(fInputString) < fSlowChecksSizeMax;
  Result := ExecPrim(1, False, SlowChecks, False);
end; { of function TRegExpr.Exec
  -------------------------------------------------------------- }

function TRegExpr.Exec(AOffset: integer): boolean;
begin
  Result := ExecPrim(AOffset, False, False, False);
end; { of function TRegExpr.Exec
  -------------------------------------------------------------- }
{$ENDIF}

function TRegExpr.ExecPos(AOffset: integer {$IFDEF DefParam} = 1{$ENDIF}): boolean;
begin
  Result := ExecPrim(AOffset, False, False, False);
end; { of function TRegExpr.ExecPos
  -------------------------------------------------------------- }

{$IFDEF OverMeth}
function TRegExpr.ExecPos(AOffset: integer; ATryOnce, ABackward: boolean): boolean;
begin
  Result := ExecPrim(AOffset, ATryOnce, False, ABackward);
end;
{$ENDIF}

function TRegExpr.MatchAtOnePos(APos: PRegExprChar): boolean;
begin
  // test for lookbehind '(?<!foo)bar' before running actual MatchPrim
  if Assigned(fHelper) then
    if (APos - fHelperLen) >= fInputStart then
    begin
      fHelper.SetInputRange(APos - fHelperLen, APos);
      if fHelper.MatchAtOnePos(APos - fHelperLen) then
      begin
        Result := False;
        Exit;
      end;
    end;

  regInput := APos;
  regCurrentGrp := -1;
  regNestedCalls := 0;
  regRecursion := 0;
  Result := MatchPrim(regCodeWork);
  if Result then
  begin
    GrpBounds[0].GrpStart[0] := APos;
    GrpBounds[0].GrpEnd[0] := regInput;

    // with lookbehind, increase found position by the len of group=1
    if regLookbehind then
      Inc(GrpBounds[0].GrpStart[0], GrpBounds[0].GrpEnd[1] - GrpBounds[0].GrpStart[1]);

    // with lookahead, decrease ending by the len of group=regLookaheadGroup
    if regLookahead and (regLookaheadGroup > 0) then
      Dec(GrpBounds[0].GrpEnd[0], GrpBounds[0].GrpEnd[regLookaheadGroup] - GrpBounds[0].GrpStart[regLookaheadGroup]);
  end;
end;

procedure TRegExpr.ClearMatches;
begin
  FillChar(GrpBounds, SizeOf(GrpBounds), 0);
  FillChar(GrpAtomicDone, SizeOf(GrpAtomicDone), 0);
  FillChar(GrpSubCalled, SizeOf(GrpSubCalled), 0);
end;

procedure TRegExpr.ClearInternalIndexes;
var
  i: integer;
begin
  FillChar(GrpBounds, SizeOf(GrpBounds), 0);
  FillChar(GrpAtomic, SizeOf(GrpAtomic), 0);
  FillChar(GrpAtomicDone, SizeOf(GrpAtomicDone), 0);
  FillChar(GrpSubCalled, SizeOf(GrpSubCalled), 0);
  FillChar(GrpOpCodes, SizeOf(GrpOpCodes), 0);

  for i := 0 to RegexMaxGroups - 1 do
  begin
    GrpIndexes[i] := -1;
    GrpNames[i] := '';
  end;
  GrpIndexes[0] := 0;
  GrpCount := 0;
end;

function TRegExpr.ExecPrim(AOffset: integer;
  ATryOnce, ASlowChecks, ABackward: boolean): boolean;
var
  Ptr: PRegExprChar;
begin
  Result := False;

  // Ensure that Match cleared either if optimization tricks or some error
  // will lead to leaving ExecPrim without actual search. That is
  // important for ExecNext logic and so on.
  ClearMatches;

  // Don't check IsProgrammOk here! it causes big slowdown in test_benchmark!
  if programm = nil then
  begin
    Compile;
    if programm = nil then
      Exit;
  end;

  if fInputString = '' then
  begin
    // Empty string can match e.g. '^$'
    if regMustLen > 0 then
      Exit;
  end;

  // Check that the start position is not negative
  if AOffset < 1 then
  begin
    Error(reeOffsetMustBePositive);
    Exit;
  end;

  // Check that the start position is not longer than the line
  if AOffset > (Length(fInputString) + 1) then
    Exit;

  Ptr := fInputStart + AOffset - 1;

  // If there is a "must appear" string, look for it.
  if ASlowChecks then
    if regMustString <> '' then
      if Pos(regMustString, fInputString) = 0 then Exit;

  {$IFDEF ComplexBraces}
  // no loops started
  LoopStackIdx := 0; // ###0.925
  {$ENDIF}

  // ATryOnce or anchored match (it needs to be tried only once).
  if ATryOnce or (regAnchored <> #0) then
  begin
    {$IFDEF UseFirstCharSet}
    {$IFDEF UnicodeRE}
    if Ord(Ptr^) <= $FF then
    {$ENDIF}
      if not FirstCharArray[byte(Ptr^)] then
        Exit;
    {$ENDIF}

    Result := MatchAtOnePos(Ptr);
    Exit;
  end;

  // Messy cases: unanchored match.
  if ABackward then
    Inc(Ptr, 2)
  else
    Dec(Ptr);
  repeat
    if ABackward then
    begin
      Dec(Ptr);
      if Ptr < fInputStart then
        Exit;
    end
    else
    begin
      Inc(Ptr);
      if Ptr > fInputEnd then
        Exit;
    end;

    {$IFDEF UseFirstCharSet}
    {$IFDEF UnicodeRE}
    if Ord(Ptr^) <= $FF then
    {$ENDIF}
      if not FirstCharArray[byte(Ptr^)] then
        Continue;
    {$ENDIF}

    Result := MatchAtOnePos(Ptr);
    // Exit on a match or after testing the end-of-string
    if Result then
      Exit;
  until False;
end; { of function TRegExpr.ExecPrim
  -------------------------------------------------------------- }

function TRegExpr.ExecNext(ABackward: boolean {$IFDEF DefParam} = False{$ENDIF}): boolean;
var
  PtrBegin, PtrEnd: PRegExprChar;
  Offset: PtrInt;
begin
  PtrBegin := GrpBounds[0].GrpStart[0];
  PtrEnd := GrpBounds[0].GrpEnd[0];
  if (PtrBegin = nil) or (PtrEnd = nil) then
  begin
    Error(reeExecNextWithoutExec);
    Result := False;
    Exit;
  end;

  Offset := PtrEnd - fInputStart + 1;
  // prevent infinite looping if empty string matches r.e.
  if PtrBegin = PtrEnd then
    Inc(Offset);

  Result := ExecPrim(Offset, False, False, ABackward);
end; { of function TRegExpr.ExecNext
  -------------------------------------------------------------- }

procedure TRegExpr.SetInputString(const AInputString: RegExprString);
begin
  ClearMatches;

  fInputString := AInputString;
  UniqueString(fInputString);

  fInputStart := PRegExprChar(fInputString);
  fInputEnd := fInputStart + Length(fInputString);
end;

procedure TRegExpr.SetInputRange(AStart, AEnd: PRegExprChar);
begin
  fInputString := '';
  fInputStart := AStart;
  fInputEnd := AEnd;
end;

{$IFDEF UseLineSep}
procedure TRegExpr.SetLineSeparators(const AStr: RegExprString);
begin
  if AStr <> fLineSeparators then
  begin
    fLineSeparators := AStr;
    InitLineSepArray;
    InvalidateProgramm;
  end;
end; { of procedure TRegExpr.SetLineSeparators
  -------------------------------------------------------------- }
{$ENDIF}

procedure TRegExpr.SetUsePairedBreak(AValue: boolean);
begin
  if AValue <> fUsePairedBreak then
  begin
    fUsePairedBreak := AValue;
    InvalidateProgramm;
  end;
end;

function TRegExpr.Substitute(const ATemplate: RegExprString): RegExprString;
// perform substitutions after a regexp match
var
  TemplateBeg, TemplateEnd: PRegExprChar;

  function ParseVarName(var APtr: PRegExprChar): integer;
  // extract name of variable: $1 or ${1} or ${name}
  // from APtr^, uses TemplateEnd
  var
    p: PRegExprChar;
    Delimited: boolean;
    GrpName: RegExprString;
  begin
    Result := 0;
    GrpName := '';
    p := APtr;
    Delimited := (p < TemplateEnd) and (p^ = '{');
    if Delimited then
      Inc(p); // skip left curly brace
    if (p < TemplateEnd) and (p^ = '&') then
      Inc(p) // this is '$&' or '${&}'
    else
    begin
      if IsDigitChar(p^) then
      begin
        while (p < TemplateEnd) and IsDigitChar(p^) do
        begin
          Result := Result * 10 + (Ord(p^) - Ord('0'));
          Inc(p);
        end
      end
      else
      if Delimited then
      begin
        FindGroupName(p, TemplateEnd, '}', GrpName);
        Result := MatchIndexFromName(GrpName);
        Inc(p, Length(GrpName));
      end;
    end;
    if Delimited then
      if (p < TemplateEnd) and (p^ = '}') then
        Inc(p) // skip right curly brace
      else
        p := APtr; // isn't properly terminated
    if p = APtr then
      Result := -1; // no valid digits found or no right curly brace
    APtr := p;
  end;

  procedure FindSubstGroupIndex(var p: PRegExprChar; var Idx: integer; var NumberFound: boolean);
  begin
    Idx := ParseVarName(p);
    NumberFound := (Idx >= 0) and (Idx <= High(GrpIndexes));
    if NumberFound then
      Idx := GrpIndexes[Idx];
  end;

type
  TSubstMode = (smodeNormal, smodeOneUpper, smodeOneLower, smodeAllUpper, smodeAllLower);
var
  Mode: TSubstMode;
  p, p0, p1, ResultPtr: PRegExprChar;
  ResultLen, n: integer;
  Ch, QuotedChar: REChar;
  GroupFound: boolean;
begin
  // Check programm and input string
  if not IsProgrammOk then
    Exit;
  // Note: don't check for empty fInputString, it's valid case,
  // e.g. user needs to replace regex "\b" to "_", it's zero match length
  if ATemplate = '' then
  begin
    Result := '';
    Exit;
  end;
  TemplateBeg := PRegExprChar(ATemplate);
  TemplateEnd := TemplateBeg + Length(ATemplate);
  // Count result length for speed optimization.
  ResultLen := 0;
  p := TemplateBeg;
  while p < TemplateEnd do
  begin
    Ch := p^;
    Inc(p);
    n := -1;
    GroupFound := False;
    if Ch = SubstituteGroupChar then
      FindSubstGroupIndex(p, n, GroupFound);
    if GroupFound then
    begin
      if n >= 0 then
        Inc(ResultLen, GrpBounds[0].GrpEnd[n] - GrpBounds[0].GrpStart[n]);
    end
    else
    begin
      if (Ch = EscChar) and (p < TemplateEnd) then
      begin // quoted or special AnsiChar followed
        Ch := p^;
        Inc(p);
        case Ch of
          'n':
            Inc(ResultLen, Length(fReplaceLineEnd));
          'u', 'l', 'U', 'L': { nothing }
            ;
          'x':
            begin
              Inc(ResultLen);
              if (p^ = '{') then
              begin // skip \x{....}
                while ((p^ <> '}') and (p < TemplateEnd)) do
                  p := p + 1;
                p := p + 1;
              end
              else
                p := p + 2 // skip \x..
            end;
        else
          Inc(ResultLen);
        end;
      end
      else
        Inc(ResultLen);
    end;
  end;
  // Get memory. We do it once and it significant speed up work !
  if ResultLen = 0 then
  begin
    Result := '';
    Exit;
  end;
  SetLength(Result, ResultLen);
  // Fill Result
  ResultPtr := PRegExprChar(Result);
  p := TemplateBeg;
  Mode := smodeNormal;
  while p < TemplateEnd do
  begin
    Ch := p^;
    p0 := p;
    Inc(p);
    p1 := p;
    n := -1;
    GroupFound := False;
    if Ch = SubstituteGroupChar then
      FindSubstGroupIndex(p, n, GroupFound);
    if GroupFound then
    begin
      if n >= 0 then
      begin
        p0 := GrpBounds[0].GrpStart[n];
        p1 := GrpBounds[0].GrpEnd[n];
      end
      else
        p1 := p0;
    end
    else
    begin
      if (Ch = EscChar) and (p < TemplateEnd) then
      begin // quoted or special AnsiChar followed
        Ch := p^;
        Inc(p);
        case Ch of
          'n':
            begin
              p0 := PRegExprChar(fReplaceLineEnd);
              p1 := p0 + Length(fReplaceLineEnd);
            end;
          'x', 't', 'r', 'f', 'a', 'e':
            begin
              p := p - 1;
              // UnquoteChar expects the escaped AnsiChar under the pointer
              QuotedChar := UnQuoteChar(p, TemplateEnd);
              p := p + 1;
              // Skip after last part of the escaped sequence - UnquoteChar stops on the last symbol of it
              p0 := @QuotedChar;
              p1 := p0 + 1;
            end;
          'l':
            begin
              Mode := smodeOneLower;
              p1 := p0;
            end;
          'L':
            begin
              Mode := smodeAllLower;
              p1 := p0;
            end;
          'u':
            begin
              Mode := smodeOneUpper;
              p1 := p0;
            end;
          'U':
            begin
              Mode := smodeAllUpper;
              p1 := p0;
            end;
        else
          begin
            Inc(p0);
            Inc(p1);
          end;
        end;
      end
    end;
    if p0 < p1 then
    begin
      while p0 < p1 do
      begin
        case Mode of
          smodeOneLower:
            begin
              ResultPtr^ := _LowerCase(p0^);
              Mode := smodeNormal;
            end;
          smodeAllLower:
            begin
              ResultPtr^ := _LowerCase(p0^);
            end;
          smodeOneUpper:
            begin
              ResultPtr^ := _UpperCase(p0^);
              Mode := smodeNormal;
            end;
          smodeAllUpper:
            begin
              ResultPtr^ := _UpperCase(p0^);
            end;
        else
          ResultPtr^ := p0^;
        end;
        Inc(ResultPtr);
        Inc(p0);
      end;
      Mode := smodeNormal;
    end;
  end;
end; { of function TRegExpr.Substitute
  -------------------------------------------------------------- }

procedure TRegExpr.Split(const AInputStr: RegExprString; APieces: TStrings);
var
  PrevPos: PtrInt;
begin
  PrevPos := 1;
  if Exec(AInputStr) then
    repeat
      APieces.Add(System.Copy(AInputStr, PrevPos, MatchPos[0] - PrevPos));
      PrevPos := MatchPos[0] + MatchLen[0];
    until not ExecNext;
  APieces.Add(System.Copy(AInputStr, PrevPos, MaxInt)); // Tail
end; { of procedure TRegExpr.Split
  -------------------------------------------------------------- }

function TRegExpr.Replace(const AInputStr: RegExprString;
  const AReplaceStr: RegExprString;
  AUseSubstitution: boolean{$IFDEF DefParam} = False{$ENDIF}): RegExprString;
var
  PrevPos: PtrInt;
begin
  Result := '';
  PrevPos := 1;
  if Exec(AInputStr) then
    repeat
      Result := Result + System.Copy(AInputStr, PrevPos, MatchPos[0] - PrevPos);
      if AUseSubstitution // ###0.946
      then
        Result := Result + Substitute(AReplaceStr)
      else
        Result := Result + AReplaceStr;
      PrevPos := MatchPos[0] + MatchLen[0];
    until not ExecNext;
  Result := Result + System.Copy(AInputStr, PrevPos, MaxInt); // Tail
end; { of function TRegExpr.Replace
  -------------------------------------------------------------- }

function TRegExpr.ReplaceEx(const AInputStr: RegExprString;
  AReplaceFunc: TRegExprReplaceFunction): RegExprString;
var
  PrevPos: PtrInt;
begin
  Result := '';
  PrevPos := 1;
  if Exec(AInputStr) then
    repeat
      Result := Result + System.Copy(AInputStr, PrevPos, MatchPos[0] - PrevPos)
        + AReplaceFunc(Self);
      PrevPos := MatchPos[0] + MatchLen[0];
    until not ExecNext;
  Result := Result + System.Copy(AInputStr, PrevPos, MaxInt); // Tail
end; { of function TRegExpr.ReplaceEx
  -------------------------------------------------------------- }

{$IFDEF OverMeth}
function TRegExpr.Replace(const AInputStr: RegExprString;
  AReplaceFunc: TRegExprReplaceFunction): RegExprString;
begin
  Result := ReplaceEx(AInputStr, AReplaceFunc);
end; { of function TRegExpr.Replace
  -------------------------------------------------------------- }
{$ENDIF}
{ ============================================================= }
{ ====================== Debug section ======================== }
{ ============================================================= }

{$IFDEF UseFirstCharSet}
procedure TRegExpr.FillFirstCharSet(prog: PRegExprChar);
var
  scan: PRegExprChar; // Current node.
  Next: PRegExprChar; // Next node.
  opnd: PRegExprChar;
  Oper: TREOp;
  ch: REChar;
  min_cnt: integer;
  {$IFDEF UseLineSep}
  i: integer;
  {$ENDIF}
  TempSet: TRegExprCharset;
begin
  TempSet := [];
  scan := prog;
  while scan <> nil do
  begin
    Next := regNext(scan);
    Oper := PREOp(scan)^;
    case Oper of
      OP_BSUBEXP,
      OP_BSUBEXPCI:
        begin
          // we cannot optimize r.e. if it starts with back reference
          FirstCharSet := RegExprAllSet; //###0.930
          Exit;
        end;

      OP_BOL,
      OP_BOLML:
        ; // Exit; //###0.937

      OP_EOL,
      OP_EOL2,
      OP_EOLML:
        begin //###0.948 was empty in 0.947, was EXIT in 0.937
          Include(FirstCharSet, 0);
          if ModifierM then
          begin
            {$IFDEF UseLineSep}
            for i := 1 to Length(LineSeparators) do
              Include(FirstCharSet, byte(LineSeparators[i]));
            {$ELSE}
            FirstCharSet := FirstCharSet + RegExprLineSeparatorsSet;
            {$ENDIF}
          end;
          Exit;
        end;

      OP_BOUND,
      OP_NOTBOUND:
        ; //###0.943 ?!!

      OP_ANY,
      OP_ANYML:
        begin // we can better define ANYML !!!
          FirstCharSet := RegExprAllSet; //###0.930
          Exit;
        end;

      OP_ANYDIGIT:
        begin
          FirstCharSet := FirstCharSet + RegExprDigitSet;
          Exit;
        end;

      OP_NOTDIGIT:
        begin
          FirstCharSet := FirstCharSet + (RegExprAllSet - RegExprDigitSet);
          Exit;
        end;

      OP_ANYLETTER:
        begin
          GetCharSetFromWordChars(TempSet);
          FirstCharSet := FirstCharSet + TempSet;
          Exit;
        end;

      OP_NOTLETTER:
        begin
          GetCharSetFromWordChars(TempSet);
          FirstCharSet := FirstCharSet + (RegExprAllSet - TempSet);
          Exit;
        end;

      OP_ANYSPACE:
        begin
          GetCharSetFromSpaceChars(TempSet);
          FirstCharSet := FirstCharSet + TempSet;
          Exit;
        end;

      OP_NOTSPACE:
        begin
          GetCharSetFromSpaceChars(TempSet);
          FirstCharSet := FirstCharSet + (RegExprAllSet - TempSet);
          Exit;
        end;

      OP_ANYVERTSEP:
        begin
          FirstCharSet := FirstCharSet + RegExprLineSeparatorsSet;
          Exit;
        end;

      OP_NOTVERTSEP:
        begin
          FirstCharSet := FirstCharSet + (RegExprAllSet - RegExprLineSeparatorsSet);
          Exit;
        end;

      OP_ANYHORZSEP:
        begin
          FirstCharSet := FirstCharSet + RegExprHorzSeparatorsSet;
          Exit;
        end;

      OP_NOTHORZSEP:
        begin
          FirstCharSet := FirstCharSet + (RegExprAllSet - RegExprHorzSeparatorsSet);
          Exit;
        end;

      OP_EXACTLYCI:
        begin
          ch := (scan + REOpSz + RENextOffSz + RENumberSz)^;
          {$IFDEF UnicodeRE}
          if Ord(ch) <= $FF then
          {$ENDIF}
          begin
            Include(FirstCharSet, byte(ch));
            Include(FirstCharSet, byte(InvertCase(ch)));
          end;
          Exit;
        end;

      OP_EXACTLY:
        begin
          ch := (scan + REOpSz + RENextOffSz + RENumberSz)^;
          {$IFDEF UnicodeRE}
          if Ord(ch) <= $FF then
          {$ENDIF}
            Include(FirstCharSet, byte(ch));
          Exit;
        end;

      OP_ANYOF:
        begin
          GetCharSetFromCharClass(scan + REOpSz + RENextOffSz, False, TempSet);
          FirstCharSet := FirstCharSet + TempSet;
          Exit;
        end;

      OP_ANYBUT:
        begin
          GetCharSetFromCharClass(scan + REOpSz + RENextOffSz, False, TempSet);
          FirstCharSet := FirstCharSet + (RegExprAllSet - TempSet);
          Exit;
        end;

      OP_ANYOFCI:
        begin
          GetCharSetFromCharClass(scan + REOpSz + RENextOffSz, True, TempSet);
          FirstCharSet := FirstCharSet + TempSet;
          Exit;
        end;

      OP_ANYBUTCI:
        begin
          GetCharSetFromCharClass(scan + REOpSz + RENextOffSz, True, TempSet);
          FirstCharSet := FirstCharSet + (RegExprAllSet - TempSet);
          Exit;
        end;

      OP_NOTHING:
        ;
      OP_COMMENT:
        ;
      OP_BACK:
        ;

      OP_OPEN_FIRST .. OP_OPEN_LAST:
        begin
          FillFirstCharSet(Next);
          Exit;
        end;

      OP_CLOSE_FIRST .. OP_CLOSE_LAST:
        begin
          FillFirstCharSet(Next);
          Exit;
        end;

      OP_BRANCH:
        begin
          if (PREOp(Next)^ <> OP_BRANCH) // No choice.
          then
            Next := scan + REOpSz + RENextOffSz // Avoid recursion.
          else
          begin
            repeat
              FillFirstCharSet(scan + REOpSz + RENextOffSz);
              scan := regNext(scan);
            until (scan = nil) or (PREOp(scan)^ <> OP_BRANCH);
            Exit;
          end;
        end;

      {$IFDEF ComplexBraces}
      OP_LOOPENTRY:
        begin //###0.925
          //LoopStack [LoopStackIdx] := 0; //###0.940 line removed
          FillFirstCharSet(Next); // execute LOOP
          Exit;
        end;

      OP_LOOP,
      OP_LOOPNG:
        begin //###0.940
          opnd := scan + PRENextOff(AlignToPtr(scan + REOpSz + RENextOffSz + REBracesArgSz * 2))^;
          min_cnt := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz))^;
          FillFirstCharSet(opnd);
          if min_cnt = 0 then
            FillFirstCharSet(Next);
          Exit;
        end;
      {$ENDIF}

      OP_STAR,
      OP_STARNG,
      OP_STAR_POSS: //###0.940
        FillFirstCharSet(scan + REOpSz + RENextOffSz);

      OP_PLUS,
      OP_PLUSNG,
      OP_PLUS_POSS:
        begin //###0.940
          FillFirstCharSet(scan + REOpSz + RENextOffSz);
          Exit;
        end;

      OP_BRACES,
      OP_BRACESNG,
      OP_BRACES_POSS:
        begin //###0.940
          opnd := scan + REOpSz + RENextOffSz + REBracesArgSz * 2;
          min_cnt := PREBracesArg(AlignToPtr(scan + REOpSz + RENextOffSz))^; // BRACES
          FillFirstCharSet(opnd);
          if min_cnt > 0 then
            Exit;
        end;

      OP_EEND:
        begin
          FirstCharSet := RegExprAllSet; //###0.948
          Exit;
        end;

      OP_ANYCATEGORY,
      OP_NOTCATEGORY:
        begin
          FirstCharSet := RegExprAllSet;
          Exit;
        end;

      OP_RECUR,
      OP_SUBCALL_FIRST .. OP_SUBCALL_LAST:
        begin
        end

      else
        begin
          fLastErrorOpcode := Oper;
          Error(reeUnknownOpcodeInFillFirst);
          Exit;
        end;
    end; { of case scan^}
    scan := Next;
  end; { of while scan <> nil}
end; { of procedure FillFirstCharSet
--------------------------------------------------------------}
{$ENDIF}

procedure TRegExpr.InitCharCheckers;
var
  Cnt: integer;
  //
  function Add(AChecker: TRegExprCharChecker): byte;
  begin
    Inc(Cnt);
    if Cnt > High(CharCheckers) then
      Error(reeTooSmallCheckersArray);
    CharCheckers[Cnt - 1] := AChecker;
    Result := Cnt - 1;
  end;
  //
begin
  Cnt := 0;
  FillChar(CharCheckers, SizeOf(CharCheckers), 0);

  CheckerIndex_Word := Add(CharChecker_Word);
  CheckerIndex_NotWord := Add(CharChecker_NotWord);
  CheckerIndex_Space := Add(CharChecker_Space);
  CheckerIndex_NotSpace := Add(CharChecker_NotSpace);
  CheckerIndex_Digit := Add(CharChecker_Digit);
  CheckerIndex_NotDigit := Add(CharChecker_NotDigit);
  CheckerIndex_VertSep := Add(CharChecker_VertSep);
  CheckerIndex_NotVertSep := Add(CharChecker_NotVertSep);
  CheckerIndex_HorzSep := Add(CharChecker_HorzSep);
  CheckerIndex_NotHorzSep := Add(CharChecker_NotHorzSep);
  //CheckerIndex_AllAZ := Add(CharChecker_AllAZ);
  CheckerIndex_LowerAZ := Add(CharChecker_LowerAZ);
  CheckerIndex_UpperAZ := Add(CharChecker_UpperAZ);

  SetLength(CharCheckerInfos, 3);
  with CharCheckerInfos[0] do
  begin
    CharBegin := 'a';
    CharEnd:= 'z';
    CheckerIndex := CheckerIndex_LowerAZ;
  end;
  with CharCheckerInfos[1] do
  begin
    CharBegin := 'A';
    CharEnd := 'Z';
    CheckerIndex := CheckerIndex_UpperAZ;
  end;
  with CharCheckerInfos[2] do
  begin
    CharBegin := '0';
    CharEnd := '9';
    CheckerIndex := CheckerIndex_Digit;
  end;
end;

function TRegExpr.CharChecker_Word(ch: REChar): boolean;
begin
  Result := IsWordChar(ch);
end;

function TRegExpr.CharChecker_NotWord(ch: REChar): boolean;
begin
  Result := not IsWordChar(ch);
end;

function TRegExpr.CharChecker_Space(ch: REChar): boolean;
begin
  Result := IsSpaceChar(ch);
end;

function TRegExpr.CharChecker_NotSpace(ch: REChar): boolean;
begin
  Result := not IsSpaceChar(ch);
end;

function TRegExpr.CharChecker_Digit(ch: REChar): boolean;
begin
  Result := IsDigitChar(ch);
end;

function TRegExpr.CharChecker_NotDigit(ch: REChar): boolean;
begin
  Result := not IsDigitChar(ch);
end;

function TRegExpr.CharChecker_VertSep(ch: REChar): boolean;
begin
  Result := IsVertLineSeparator(ch);
end;

function TRegExpr.CharChecker_NotVertSep(ch: REChar): boolean;
begin
  Result := not IsVertLineSeparator(ch);
end;

function TRegExpr.CharChecker_HorzSep(ch: REChar): boolean;
begin
  Result := IsHorzSeparator(ch);
end;

function TRegExpr.CharChecker_NotHorzSep(ch: REChar): boolean;
begin
  Result := not IsHorzSeparator(ch);
end;

function TRegExpr.CharChecker_LowerAZ(ch: REChar): boolean;
begin
  case ch of
    'a' .. 'z':
      Result := True;
    else
      Result := False;
  end;
end;

function TRegExpr.CharChecker_UpperAZ(ch: REChar): boolean;
begin
  case ch of
    'A' .. 'Z':
      Result := True;
    else
      Result := False;
  end;
end;


{$IFDEF RegExpPCodeDump}

function TRegExpr.DumpOp(op: TREOp): RegExprString;
// printable representation of opcode
begin
  case op of
    OP_BOL:
      Result := 'BOL';
    OP_EOL:
      Result := 'EOL';
    OP_EOL2:
      Result := 'EOL2';
    OP_BOLML:
      Result := 'BOLML';
    OP_EOLML:
      Result := 'EOLML';
    OP_BOUND:
      Result := 'BOUND';
    OP_NOTBOUND:
      Result := 'NOTBOUND';
    OP_ANY:
      Result := 'ANY';
    OP_ANYML:
      Result := 'ANYML';
    OP_ANYLETTER:
      Result := 'ANYLETTER';
    OP_NOTLETTER:
      Result := 'NOTLETTER';
    OP_ANYDIGIT:
      Result := 'ANYDIGIT';
    OP_NOTDIGIT:
      Result := 'NOTDIGIT';
    OP_ANYSPACE:
      Result := 'ANYSPACE';
    OP_NOTSPACE:
      Result := 'NOTSPACE';
    OP_ANYHORZSEP:
      Result := 'ANYHORZSEP';
    OP_NOTHORZSEP:
      Result := 'NOTHORZSEP';
    OP_ANYVERTSEP:
      Result := 'ANYVERTSEP';
    OP_NOTVERTSEP:
      Result := 'NOTVERTSEP';
    OP_ANYOF:
      Result := 'ANYOF';
    OP_ANYBUT:
      Result := 'ANYBUT';
    OP_ANYOFCI:
      Result := 'ANYOF/CI';
    OP_ANYBUTCI:
      Result := 'ANYBUT/CI';
    OP_BRANCH:
      Result := 'BRANCH';
    OP_EXACTLY:
      Result := 'EXACTLY';
    OP_EXACTLYCI:
      Result := 'EXACTLY/CI';
    OP_NOTHING:
      Result := 'NOTHING';
    OP_COMMENT:
      Result := 'COMMENT';
    OP_BACK:
      Result := 'BACK';
    OP_EEND:
      Result := 'END';
    OP_BSUBEXP:
      Result := 'BSUBEXP';
    OP_BSUBEXPCI:
      Result := 'BSUBEXP/CI';
    OP_OPEN_FIRST .. OP_OPEN_LAST:
      Result := Format('OPEN[%d]', [Ord(op) - Ord(OP_OPEN)]);
    OP_CLOSE_FIRST .. OP_CLOSE_LAST:
      Result := Format('CLOSE[%d]', [Ord(op) - Ord(OP_CLOSE)]);
    OP_STAR:
      Result := 'STAR';
    OP_PLUS:
      Result := 'PLUS';
    OP_BRACES:
      Result := 'BRACES';
    {$IFDEF ComplexBraces}
    OP_LOOPENTRY:
      Result := 'LOOPENTRY';
    OP_LOOP:
      Result := 'LOOP';
    OP_LOOPNG:
      Result := 'LOOPNG';
    {$ENDIF}
    OP_STARNG:
      Result := 'STARNG';
    OP_PLUSNG:
      Result := 'PLUSNG';
    OP_BRACESNG:
      Result := 'BRACESNG';
    OP_STAR_POSS:
      Result := 'STAR_POSS';
    OP_PLUS_POSS:
      Result := 'PLUS_POSS';
    OP_BRACES_POSS:
      Result := 'BRACES_POSS';
    OP_ANYCATEGORY:
      Result := 'ANYCATEG';
    OP_NOTCATEGORY:
      Result := 'NOTCATEG';
    OP_RECUR:
      Result := 'RECURSION';
    OP_SUBCALL_FIRST .. OP_SUBCALL_LAST:
      Result := Format('SUBCALL[%d]', [Ord(op) - Ord(OP_SUBCALL)]);
  else
    Error(reeDumpCorruptedOpcode);
  end;
end; { of function TRegExpr.DumpOp
  -------------------------------------------------------------- }

function TRegExpr.IsCompiled: boolean;
begin
  Result := programm <> nil;
end;

function PrintableChar(AChar: REChar): RegExprString; {$IFDEF InlineFuncs}inline;{$ENDIF}
begin
  if AChar < ' ' then
    Result := '#' + IntToStr(Ord(AChar))
  else
    Result := AChar;
end;

function TRegExpr.DumpCheckerIndex(N: byte): RegExprString;
begin
  Result := '?';
  if N = CheckerIndex_Word       then Result := '\w' else
  if N = CheckerIndex_NotWord    then Result := '\W' else
  if N = CheckerIndex_Digit      then Result := '\d' else
  if N = CheckerIndex_NotDigit   then Result := '\D' else
  if N = CheckerIndex_Space      then Result := '\s' else
  if N = CheckerIndex_NotSpace   then Result := '\S' else
  if N = CheckerIndex_HorzSep    then Result := '\h' else
  if N = CheckerIndex_NotHorzSep then Result := '\H' else
  if N = CheckerIndex_VertSep    then Result := '\v' else
  if N = CheckerIndex_NotVertSep then Result := '\V' else
  if N = CheckerIndex_LowerAZ    then Result := 'az' else
  if N = CheckerIndex_UpperAZ    then Result := 'AZ' else
  ;
end;

function TRegExpr.DumpCategoryChars(ch, ch2: REChar; Positive: boolean): RegExprString;
const
  S: array[boolean] of RegExprString = ('P', 'p');
begin
  Result := '\' + S[Positive] + '{' + ch;
  if ch2 <> #0 then
    Result := Result + ch2;
  Result := Result + '} ';
end;

function TRegExpr.Dump: RegExprString;
// dump a regexp in vaguely comprehensible form
var
  s: PRegExprChar;
  op: TREOp; // Arbitrary non-END op.
  next: PRegExprChar;
  i, NLen: integer;
  Diff: PtrInt;
  iByte: byte;
  ch, ch2: REChar;
begin
  if not IsProgrammOk then
    Exit;

  op := OP_EXACTLY;
  Result := '';
  s := regCodeWork;
  while op <> OP_EEND do
  begin // While that wasn't END last time...
    op := s^;
    Result := Result + Format('%2d: %s', [s - programm, DumpOp(s^)]);
    // Where, what.
    next := regNext(s);
    if next = nil // Next ptr.
    then
      Result := Result + ' (0)'
    else
    begin
      if next > s
      // ###0.948 PWideChar subtraction workaround (see comments in Tail method for details)
      then
        Diff := next - s
      else
        Diff := -(s - next);
      Result := Result + Format(' (%d) ', [(s - programm) + Diff]);
    end;
    Inc(s, REOpSz + RENextOffSz);
    if (op = OP_ANYOF) or (op = OP_ANYOFCI) or (op = OP_ANYBUT) or (op = OP_ANYBUTCI) then
    begin
      repeat
        case s^ of
          OpKind_End:
            begin
              Inc(s);
              Break;
            end;
          OpKind_Range:
            begin
              Result := Result + 'Rng(';
              Inc(s);
              Result := Result + PrintableChar(s^) + '-';
              Inc(s);
              Result := Result + PrintableChar(s^);
              Result := Result + ') ';
              Inc(s);
            end;
          OpKind_MetaClass:
            begin
              Inc(s);
              Result := Result + DumpCheckerIndex(byte(s^)) + ' ';
              Inc(s);
            end;
          OpKind_Char:
            begin
              Inc(s);
              NLen := PLongInt(s)^;
              Inc(s, RENumberSz);
              Result := Result + 'Ch(';
              for i := 1 to NLen do
              begin
                Result := Result + PrintableChar(s^);
                Inc(s);
              end;
              Result := Result + ') ';
            end;
          OpKind_CategoryYes:
            begin
              Inc(s);
              ch := s^;
              Inc(s);
              ch2 := s^;
              Result := Result + DumpCategoryChars(ch, ch2, True);
              Inc(s);
            end;
          OpKind_CategoryNo:
            begin
              Inc(s);
              ch := s^;
              Inc(s);
              ch2 := s^;
              Result := Result + DumpCategoryChars(ch, ch2, False);
              Inc(s);
            end;
          else
            Error(reeDumpCorruptedOpcode);
        end;
      until false;
    end;
    if (op = OP_EXACTLY) or (op = OP_EXACTLYCI) then
    begin
      // Literal string, where present.
      NLen := PLongInt(s)^;
      Inc(s, RENumberSz);
      for i := 1 to NLen do
      begin
        Result := Result + PrintableChar(s^);
        Inc(s);
      end;
    end;
    if (op = OP_BSUBEXP) or (op = OP_BSUBEXPCI) then
    begin
      Result := Result + ' \' + IntToStr(Ord(s^));
      Inc(s);
    end;
    if (op = OP_BRACES) or (op = OP_BRACESNG) or (op = OP_BRACES_POSS) then
    begin // ###0.941
      // show min/max argument of braces operator
      Result := Result + Format('{%d,%d}', [PREBracesArg(AlignToInt(s))^,
        PREBracesArg(AlignToInt(s + REBracesArgSz))^]);
      Inc(s, REBracesArgSz * 2);
    end;
    {$IFDEF ComplexBraces}
    if (op = OP_LOOP) or (op = OP_LOOPNG) then
    begin // ###0.940
      Result := Result + Format(' -> (%d) {%d,%d}',
        [(s - programm - (REOpSz + RENextOffSz)) +
        PRENextOff(AlignToPtr(s + 2 * REBracesArgSz))^,
        PREBracesArg(AlignToInt(s))^,
        PREBracesArg(AlignToInt(s + REBracesArgSz))^]);
      Inc(s, 2 * REBracesArgSz + RENextOffSz);
    end;
    {$ENDIF}
    if (op = OP_ANYCATEGORY) or (op = OP_NOTCATEGORY) then
    begin
      ch := s^;
      Inc(s);
      ch2 := s^;
      Inc(s);
      if ch2<>#0 then
        Result := Result + '{' + ch + ch2 + '}'
      else
        Result := Result + '{' + ch + '}';
    end;
    Result := Result + #$d#$a;
  end; { of while }

  // Header fields of interest.
  if regAnchored <> #0 then
    Result := Result + 'Anchored; ';
  if regMustString <> '' then
    Result := Result + 'Must have: "' + regMustString + '"; ';

  {$IFDEF UseFirstCharSet} // ###0.929
  Result := Result + #$d#$a'First charset: ';
  if FirstCharSet = [] then
    Result := Result + '<empty set>'
  else
  if FirstCharSet = RegExprAllSet then
    Result := Result + '<all chars>'
  else
  for iByte := 0 to 255 do
    if iByte in FirstCharSet then
      Result := Result + PrintableChar(REChar(iByte));
  {$ENDIF}
  Result := Result + #$d#$a;
end; { of function TRegExpr.Dump
  -------------------------------------------------------------- }
{$ENDIF}


function TRegExpr.IsFixedLength(var op: TREOp; var ALen: integer): boolean;
var
  s, next: PRegExprChar;
  N, N2: integer;
begin
  Result := False;
  ALen := 0;
  if not IsCompiled then Exit;
  s := regCodeWork;

  repeat
    next := regNext(s);
    op := s^;
    Inc(s, REOpSz + RENextOffSz);

    case op of
      OP_EEND:
        begin
          Result := True;
          Exit;
        end;

      OP_BRANCH:
        begin
          op := next^;
          if op <> OP_EEND then Exit;
        end;

      OP_COMMENT,
      OP_BOUND,
      OP_NOTBOUND:
        Continue;

      OP_ANY,
      OP_ANYML,
      OP_ANYDIGIT,
      OP_NOTDIGIT,
      OP_ANYLETTER,
      OP_NOTLETTER,
      OP_ANYSPACE,
      OP_NOTSPACE,
      OP_ANYHORZSEP,
      OP_NOTHORZSEP,
      OP_ANYVERTSEP,
      OP_NOTVERTSEP:
        begin
          Inc(ALen);
          Continue;
        end;

      OP_ANYOF,
      OP_ANYOFCI,
      OP_ANYBUT,
      OP_ANYBUTCI:
        begin
          Inc(ALen);
          repeat
            case s^ of
              OpKind_End:
                begin
                  Inc(s);
                  Break;
                end;
              OpKind_Range:
                begin
                  Inc(s);
                  Inc(s);
                  Inc(s);
                end;
              OpKind_MetaClass:
                begin
                  Inc(s);
                  Inc(s);
                end;
              OpKind_Char:
                begin
                  Inc(s);
                  Inc(s, RENumberSz + PLongInt(s)^);
                end;
              OpKind_CategoryYes,
              OpKind_CategoryNo:
                begin
                  Inc(s);
                  Inc(s);
                  Inc(s);
                end;
            end;
          until False;
        end;

      OP_EXACTLY,
      OP_EXACTLYCI:
        begin
          N := PLongInt(s)^;
          Inc(ALen, N);
          Inc(s, RENumberSz + N);
          Continue;
        end;

      OP_ANYCATEGORY,
      OP_NOTCATEGORY:
        begin
          Inc(ALen);
          Inc(s, 2);
          Continue;
        end;

      OP_BRACES,
      OP_BRACESNG,
      OP_BRACES_POSS:
        begin
          // allow only d{n,n}
          N := PREBracesArg(AlignToInt(s))^;
          N2 := PREBracesArg(AlignToInt(s + REBracesArgSz))^;
          if N <> N2 then
            Exit;
          Inc(ALen, N-1);
          Inc(s, REBracesArgSz * 2);
        end;

      else
        Exit;
    end;
  until False;
end;

{$IFDEF reRealExceptionAddr}
{$OPTIMIZATION ON}
// ReturnAddr works correctly only if compiler optimization is ON
// I placed this method at very end of unit because there are no
// way to restore compiler optimization flag ...
{$ENDIF}

procedure TRegExpr.Error(AErrorID: integer);
  {$IFNDEF LINUX}
  {$IFDEF reRealExceptionAddr}
  function ReturnAddr: Pointer; // ###0.938
  asm
    mov  eax,[ebp+4]
  end;
  {$ENDIF}
  {$ENDIF}
var
  e: ERegExpr;
  Msg: string;
begin
  fLastError := AErrorID; // dummy stub - useless because will raise exception
  Msg := ErrorMsg(AErrorID);
  // compilation error ?
  if AErrorID < reeFirstRuntimeCode then
    Msg := Msg + ' (pos ' + IntToStr(CompilerErrorPos) + ')';
  e := ERegExpr.Create(Msg);
  e.ErrorCode := AErrorID;
  e.CompilerErrorPos := CompilerErrorPos;
  raise e
    {$IFNDEF LINUX}
    {$IFDEF reRealExceptionAddr}
    at ReturnAddr
    {$ENDIF}
    {$ENDIF};
end; { of procedure TRegExpr.Error
  -------------------------------------------------------------- }

{$IFDEF Compat} // APIs needed only for users of old FPC 3.0
function TRegExpr.ExecPos(AOffset: integer; ATryOnce: boolean): boolean; overload;
begin
  Result := ExecPrim(AOffset, ATryOnce, False, False);
end;

function TRegExpr.OldInvertCase(const Ch: REChar): REChar;
begin
  Result := _UpperCase(Ch);
  if Result = Ch then
    Result := _LowerCase(Ch);
end;

class function TRegExpr.InvertCaseFunction(const Ch: REChar): REChar;
begin
  Result := _UpperCase(Ch);
  if Result = Ch then
    Result := _LowerCase(Ch);
end;

function TRegExpr.GetLinePairedSeparator: RegExprString;
begin
  // not supported anymore
  Result := '';
end;

procedure TRegExpr.SetLinePairedSeparator(const AValue: RegExprString);
begin
  // not supported anymore
end;

procedure TRegExpr.SetUseOsLineEndOnReplace(AValue: boolean);
begin
  if fUseOsLineEndOnReplace = AValue then
    Exit;
  fUseOsLineEndOnReplace := AValue;
  if fUseOsLineEndOnReplace then
    fReplaceLineEnd := sLineBreak
  else
    fReplaceLineEnd := #10;
end;
{$ENDIF}

end.