csregex.pas

Delphi script parser

            ch := Ansi_Translate(ch, Size, pos, FPattern, translate);
        end;
      end;
      level := ord(regexp_precedences[ord(op)]); // integer > ord
      if (level > current_level) then begin
        inc(current_level); // before or after the while??
        while current_level < level do begin
          starts[starts_base + current_level] := pattern_offset;
          inc(current_level);
        end;
        starts[starts_base + current_level] := pattern_offset;
      end else
        if level < current_level then begin
          current_level := level;
          while (num_jumps > 0) and
            (future_jumps[num_jumps - 1] >= starts[starts_base + current_level]) do
          begin
            //PUT_ADDR(offset,addr)
            //         offset = future_jumps[num_jumps-1]
            //         addr   = pattern_offset
            disp := pattern_offset - future_jumps[num_jumps - 1] - 2;
            pattern[future_jumps[num_jumps - 1]] := char(disp and 255);
            pattern[future_jumps[num_jumps - 1] + 1] := char((disp shr 8) and 255);
            dec(num_jumps);
          end;
        end;

      case op of
        Rend: ;
        Rnormal:
          begin
            normal_char:
            opcode := Cexact;
            store_opcode_and_arg: //* opcode & ch must be set */
            starts[starts_base + current_level] := pattern_offset;
            pattern := pattern + char(opcode) + ch;
            inc(pattern_offset, 2);
          end;
        Ranychar:
          begin
            opcode := CAnychar;
            store_opcode:
            starts[starts_base + current_level] := pattern_offset;
            pattern := pattern + char(opcode);
            inc(pattern_offset);
          end;
        Rquote:
          raise ERegularExpression.Create(SreAbnormal);
        Rbol:
          begin
            if not beginning_context then
              if regexp_context_indep_ops then
                raise ERegularExpression.Create(SreBadlyPSpe)
              else
                goto normal_char;
            opcode := Cbol;
            goto store_opcode;
          end;
        Reol:
          begin
            if not ((pos > size) or
              (((FStyle and RE_NO_BK_VBAR) = RE_NO_BK_VBAR) and (FPattern[pos] = #124)) or // oct 174
              (((FStyle and RE_NO_BK_VBAR) <> RE_NO_BK_VBAR) and (((pos + 1) < size) and
              (FPattern[pos] = #92) and (FPattern[pos + 1] = #124))) or // oct 92 / 174
              (((FStyle and RE_NO_BK_PARENS) = RE_NO_BK_PARENS) and (FPattern[pos] = ')')) or
              (((FStyle and RE_NO_BK_PARENS) <> RE_NO_BK_PARENS) and (((pos + 1) < size) and
              (FPattern[pos] = #92) and (FPattern[pos + 1] = ')'))) // oct 92
              ) then
              if regexp_context_indep_ops then
                raise ERegularExpression.Create(SreBadlyPSpe)
              else
                goto normal_char;
            opcode := Ceol;
            goto store_opcode;
          end;
        Roptional:
          begin
            if beginning_context then
              if regexp_context_indep_ops then
                raise ERegularExpression.Create(SreBadlyPSpe)
              else
                goto normal_char;
            if starts[starts_base + current_level] <> pattern_offset then
            begin
              pattern := pattern + #0#0#0;
              Inser_Jump(starts[starts_base + current_level], Cfailure_jump,
                pattern_offset + 3, pattern_offset, pattern);
            end;
          end;
        Rstar,
          Rplus:
          begin
            if beginning_context then
              if regexp_context_indep_ops then
                raise ERegularExpression.Create(SreBadlyPSpe)
              else
                goto normal_char;

            if starts[starts_base + current_level] <> pattern_offset then
              //* ignore empty patterns for + and * */
            begin
              Pattern := Pattern + #0#0#0#0#0#0; //#0#0#0; //ALLOC(9);
              Inser_Jump(starts[starts_base + current_level], Cfailure_jump,
                pattern_offset + 6, pattern_offset, pattern);
              Inser_Jump(pattern_offset, Cstar_jump,
                starts[starts_base + current_level], pattern_offset, pattern);
              if op = Rplus then //* jump over initial failure_jump */
              begin
                Pattern := Pattern + #0#0#0;
                Inser_Jump(starts[starts_base + current_level], Cdummy_failure_jump,
                  starts[starts_base + current_level] + 6, pattern_offset, pattern);
              end;
            end;
          end;
        Ror:
          begin
            Pattern := Pattern + #0#0#0#0#0#0; //ALLOC(6);
            Inser_Jump(starts[starts_base + current_level], Cfailure_jump,
              pattern_offset + 6, pattern_offset, pattern);
            if num_jumps >= MAX_NESTING then
              raise ERegularExpression.Create(SreToComplex);
            pattern[pattern_offset] := char(Cjump);
            inc(pattern_offset);
            future_jumps[num_jumps] := pattern_offset;
            inc(num_jumps);
//              pattern := pattern + #0#0;
            inc(pattern_offset, 2);
            starts[starts_base + current_level] := pattern_offset;
          end;
        Ropenpar:
          begin
            starts[starts_base + current_level] := pattern_offset;
            if next_register < RE_NREGS then begin
              regexp_t.uses_registers := True;
              pattern := pattern + char(Cstart_memory) + char(next_register);
              inc(pattern_offset, 2);
              open_registers[num_open_registers] := next_register;
              inc(num_open_registers);
              regexp_t.num_registers := regexp_t.num_registers + 1;
              inc(next_register);
            end;
            inc(paren_depth);
              //PUSH_LEVEL_STARTS;
            if starts_base < ((MAX_NESTING - 1) * NUM_LEVELS) then
              starts_base := starts_base + NUM_LEVELS
            else
              raise ERegularExpression.Create(SreToComplex);

            current_level := 0;
            starts[starts_base + current_level] := pattern_offset;
          end;
        Rclosepar:
          begin
            if paren_depth <= 0 then
              raise ERegularExpression.Create(SreBadlyPPar);
            dec(starts_base, NUM_LEVELS);
            current_level := ord(regexp_precedences[ord(Ropenpar)]); // integer > ord
            dec(paren_depth);
            if paren_depth < num_open_registers then begin
              regexp_t.uses_registers := True;
              dec(num_open_registers);
              pattern := pattern + char(Cend_memory) + char(open_registers[num_open_registers]);
              inc(pattern_offset, 2);
            end;
          end;
        Rmemory:
          begin
            if ch = '0' then
              raise ERegularExpression.Create(SreBadMregN);
            regexp_t.uses_registers := True;
            opcode := Cmatch_memory;
            ch := char(ord(ch) - ord('0'));
            goto store_opcode_and_arg;
          end;
        Rextended_memory:
          begin
            if pos > size then
              raise ERegularExpression.Create(SreEndPrem);
            ch := FPattern[pos];
            inc(pos);
            if (ch < '0') or (ch > '9') then
              raise ERegularExpression.Create(SreBadMregN);
            if pos > size then
              raise ERegularExpression.Create(SreEndPrem);
            a := FPattern[pos];
            inc(pos);
            if (a < '0') or (a > '9') then
              raise ERegularExpression.Create(SreBadMregN);
            ch := char(10 * (ord(a) - ord('0')) + ord(ch) - ord('0'));
            if (ch <= '0') or (ch >= char(RE_NREGS)) then
              raise ERegularExpression.Create(SreBadMregN);
            regexp_t.uses_registers := True;
            opcode := Cmatch_memory;
            goto store_opcode_and_arg;
          end;
        Ropenset:
          begin
            Starts[starts_base + current_level] := pattern_offset; //   SET_LEVEL_START;
//   ALLOC(1+256/8);
            pattern := pattern + char(Cset);
            inc(pattern_offset);
            offset := pattern_offset;
            pattern := pattern + #0#0#0#0#0#0#0#0 + #0#0#0#0#0#0#0#0 +
              #0#0#0#0#0#0#0#0 + #0#0#0#0#0#0#0#0;
            inc(pattern_offset, 32);
            if pos > size then
              raise ERegularExpression.Create(SreEndPrem);
            ch := FPattern[pos];
            inc(pos);
            if translate <> '' then ch := translate[ord(ch)];
            if ch = #94 then // was oct
            begin
              complement := True;
              if pos > size then
                raise ERegularExpression.Create(SreEndPrem);
              ch := FPattern[pos];
              inc(pos);
              if translate <> '' then
                ch := translate[ord(ch)];
            end else
              complement := False;
            prev := -1;
            range := False;
            firstchar := True;
            while (ch <> #93) or firstchar do //was oct
            begin
              Firstchar := False;
              if (regexp_ansi_sequences and (ch = #92)) then // was oct
              begin
                if pos > size then
                  raise ERegularExpression.Create(SreEndPrem);
                ch := FPattern[pos];
                inc(pos);
                Ansi_Translate(ch, size, pos, FPattern, translate);
              end;
              if range then begin
                for i := prev to ord(ch) do
                  pattern[offset + (i div 8)] := char(ord(pattern[offset + (i div 8)]) or (1 shl (i and 7))); // integer > ord
                prev := -1;
                range := False;
              end else
                if (prev <> -1) and (ch = '-') then
                  range := True
                else begin
                  pattern[offset + (ord(ch) div 8)] := char(ord(pattern[offset + (ord(ch) div 8)]) or (1 shl (ord(ch) and 7))); // integer > ord
                  prev := ord(ch);
                end;
              if pos > size then
                raise ERegularExpression.Create(SreEndPrem);
              ch := FPattern[pos];
              inc(pos);
              if translate <> '' then ch := translate[ord(ch)];
//                Ansi_Translate(ch, size, pos, FPattern, translate); stupid translation bug
            end;
            if range then
              pattern[offset + (ord('-') div 8)] := char(ord(pattern[offset + (ord('-') div 8)]) or (1 shl (ord('-') and 7))); // integer > ord
            if (complement) then begin
              for i := 0 to 256 div 8 do
                pattern[offset + i] := char(ord(pattern[offset + i]) xor 255); // integer > ord
            end;
          end;
        Rbegbuf:
          begin
            opcode := Cbegbuf;
            goto store_opcode;
          end;
        Rendbuf:
          begin
            opcode := Cendbuf;
            goto store_opcode;
          end;
        RDigitChar: // RJ 2000-04-01 must 0-9
          begin // RJ
            opcode := Csyntaxspec; // RJ
            ch := Char(SDigit); // RJ
            goto store_opcode_and_arg; // RJ
          end; // RJ
        RNotDigitChar: // RJ 2000-04-01 must not 0-9
          begin // RJ
            opcode := CNotsyntaxspec; // RJ
            ch := Char(SDigit); // RJ
            goto store_opcode_and_arg; // RJ
          end; // RJ
        Rwordchar:
          begin
            opcode := Csyntaxspec;
            ch := char(Sword);
            goto store_opcode_and_arg;
          end;
        Rnotwordchar:
          begin
            opcode := Cnotsyntaxspec;
            ch := char(Sword);
            goto store_opcode_and_arg;
          end;
        Rwordbeg:
          begin
            opcode := Cwordbeg;
            goto store_opcode;
          end;
        Rwordend:
          begin
            opcode := Cwordend;
            goto store_opcode;
          end;
        Rwordbound:
          begin
            opcode := Cwordbound;
            goto store_opcode;
          end;
        Rnotwordbound:
          begin
            opcode := Cnotwordbound;
            goto store_opcode;
          end;
      else
        raise ERegularExpression.Create(SreSyntax);
      end;
      beginning_context := (op = Ropenpar) or (op = Ror);
    end;
    if starts_base <> 0 then
      raise ERegularExpression.Create(SreBadlyPPar);
    pattern := pattern + char(Cend);
    inc(pattern_offset);
  finally
    regexp_t.buffer := pattern;
  end;
  if not re_optimize then
    raise ERegularExpression.Create(SreOptimize);
end;

{: This tries to match the regexp against the string. This returns the length of
   the matched portion, or -1 if the pattern could not be matched and -2 if an
   error (such as failure stack overflow) is encountered. }

function TcsReExpr.re_match(
  const pos: integer;
  const old_regs: Pmkre_registers): integer;
label
  continue_matching, fail, done_matching, Error;
var
  code, translate, text: PChar;
  a, b, reg, match_end: integer;
  ch: char;
  regstart, regend: PChar;
  regsize: integer;
  state: Tmatch_state;
  item: Pitem_t;

  failuredest, pinst: PChar;
  item_t: Pitem_t;
  item_t2: Pitem_t;
  index: integer;
  current: Pitem_page_t;
begin
  Assert((pos > 0) and (FBufferSize >= 0), 'Nothing to do');
  Assert((pos <= FBufferSize), 'Position not valid');
  text := PChar(integer(FBuffer) + pos - 1);
  code := @regexp_t.buffer[1];
  if regexp_t.translate <> '' then