re-engine-Hooks

 view release on metacpan or  search on metacpan

src/5021001/regcomp.c  view on Meta::CPAN

  RExC_size += 2;
  /*
  We can't do this:

  assert(2==regarglen[op]+1);

  Anything larger than this has to allocate the extra amount.
  If we changed this to be:

  RExC_size += (1 + regarglen[op]);

  then it wouldn't matter. Its not clear what side effect
  might come from that so its not done so far.
  -- dmq
  */
  return(ret);
 }
 if (RExC_emit >= RExC_emit_bound)
  Perl_croak(aTHX_ "panic: reg_node overrun trying to emit %d, %p>=%p",
    op, (void*)RExC_emit, (void*)RExC_emit_bound);

 NODE_ALIGN_FILL(ret);
 ptr = ret;
 FILL_ADVANCE_NODE_ARG(ptr, op, arg);
 REH_CALL_COMP_NODE_HOOK(pRExC_state->rx, (ptr) - 2);
#ifdef RE_TRACK_PATTERN_OFFSETS
 if (RExC_offsets) {         /* MJD */
  MJD_OFFSET_DEBUG(
   ("%s(%d): (op %s) %s %"UVuf" <- %"UVuf" (max %"UVuf").\n",
   "reganode",
   __LINE__,
   PL_reg_name[op],
   (UV)(RExC_emit - RExC_emit_start) > RExC_offsets[0] ?
   "Overwriting end of array!\n" : "OK",
   (UV)(RExC_emit - RExC_emit_start),
   (UV)(RExC_parse - RExC_start),
   (UV)RExC_offsets[0]));
  Set_Cur_Node_Offset;
 }
#endif
 RExC_emit = ptr;
 return(ret);
}

/*
- reguni - emit (if appropriate) a Unicode character
*/
PERL_STATIC_INLINE STRLEN
S_reguni(pTHX_ const RExC_state_t *pRExC_state, UV uv, char* s)
{
 dVAR;

 PERL_ARGS_ASSERT_REGUNI;

 return SIZE_ONLY ? UNISKIP(uv) : (uvchr_to_utf8((U8*)s, uv) - (U8*)s);
}

/*
- reginsert - insert an operator in front of already-emitted operand
*
* Means relocating the operand.
*/
STATIC void
S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd, U32 depth)
{
 dVAR;
 regnode *src;
 regnode *dst;
 regnode *place;
 const int offset = regarglen[(U8)op];
 const int size = NODE_STEP_REGNODE + offset;
 GET_RE_DEBUG_FLAGS_DECL;

 PERL_ARGS_ASSERT_REGINSERT;
 PERL_UNUSED_CONTEXT;
 PERL_UNUSED_ARG(depth);
/* (PL_regkind[(U8)op] == CURLY ? EXTRA_STEP_2ARGS : 0); */
 DEBUG_PARSE_FMT("inst"," - %s",PL_reg_name[op]);
 if (SIZE_ONLY) {
  RExC_size += size;
  return;
 }

 src = RExC_emit;
 RExC_emit += size;
 dst = RExC_emit;
 if (RExC_open_parens) {
  int paren;
  /*DEBUG_PARSE_FMT("inst"," - %"IVdf, (IV)RExC_npar);*/
  for ( paren=0 ; paren < RExC_npar ; paren++ ) {
   if ( RExC_open_parens[paren] >= opnd ) {
    /*DEBUG_PARSE_FMT("open"," - %d",size);*/
    RExC_open_parens[paren] += size;
   } else {
    /*DEBUG_PARSE_FMT("open"," - %s","ok");*/
   }
   if ( RExC_close_parens[paren] >= opnd ) {
    /*DEBUG_PARSE_FMT("close"," - %d",size);*/
    RExC_close_parens[paren] += size;
   } else {
    /*DEBUG_PARSE_FMT("close"," - %s","ok");*/
   }
  }
 }

 while (src > opnd) {
  StructCopy(--src, --dst, regnode);
#ifdef RE_TRACK_PATTERN_OFFSETS
  if (RExC_offsets) {     /* MJD 20010112 */
   MJD_OFFSET_DEBUG(
    ("%s(%d): (op %s) %s copy %"UVuf" -> %"UVuf" (max %"UVuf").\n",
    "reg_insert",
    __LINE__,
    PL_reg_name[op],
    (UV)(dst - RExC_emit_start) > RExC_offsets[0]
     ? "Overwriting end of array!\n" : "OK",
    (UV)(src - RExC_emit_start),
    (UV)(dst - RExC_emit_start),
    (UV)RExC_offsets[0]));
   Set_Node_Offset_To_R(dst-RExC_emit_start, Node_Offset(src));
   Set_Node_Length_To_R(dst-RExC_emit_start, Node_Length(src));



( run in 0.488 second using v1.01-cache-2.11-cpan-5511b514fd6 )