Plugin.xs

   1 /* This file is part of the re::engine::Plugin Perl module.
   2  * See http://search.cpan.org/dist/re-engine-Plugin/ */
   3
   4 #define PERL_NO_GET_CONTEXT
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8
   9 #include "Plugin.h"
  10
  11 #define __PACKAGE__     "re::engine::Plugin"
  12 #define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
  13
  14 #define REP_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
  15
  16 #ifndef REP_WORKAROUND_REQUIRE_PROPAGATION
  17 # define REP_WORKAROUND_REQUIRE_PROPAGATION !REP_HAS_PERL(5, 10, 1)
  18 #endif
  19
  20 /* ... Thread safety and multiplicity ...................................... */
  21
  22 #ifndef REP_MULTIPLICITY
  23 # if defined(MULTIPLICITY) || defined(PERL_IMPLICIT_CONTEXT)
  24 #  define REP_MULTIPLICITY 1
  25 # else
  26 #  define REP_MULTIPLICITY 0
  27 # endif
  28 #endif
  29 #if REP_MULTIPLICITY && !defined(tTHX)
  30 # define tTHX PerlInterpreter*
  31 #endif
  32
  33 #if REP_MULTIPLICITY && defined(USE_ITHREADS) && defined(dMY_CXT) && defined(MY_CXT) && defined(START_MY_CXT) && defined(MY_CXT_INIT) && (defined(MY_CXT_CLONE) || defined(dMY_CXT_SV))
  34 # define REP_THREADSAFE 1
  35 # ifndef MY_CXT_CLONE
  36 #  define MY_CXT_CLONE \
  37     dMY_CXT_SV;                                                      \
  38     my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \
  39     Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \
  40     sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
  41 # endif
  42 #else
  43 # define REP_THREADSAFE 0
  44 # undef  dMY_CXT
  45 # define dMY_CXT      dNOOP
  46 # undef  MY_CXT
  47 # define MY_CXT       rep_globaldata
  48 # undef  START_MY_CXT
  49 # define START_MY_CXT STATIC my_cxt_t MY_CXT;
  50 # undef  MY_CXT_INIT
  51 # define MY_CXT_INIT  NOOP
  52 # undef  MY_CXT_CLONE
  53 # define MY_CXT_CLONE NOOP
  54 #endif
  55
  56 /* --- Helpers ------------------------------------------------------------- */
  57
  58 /* ... Thread-safe hints ................................................... */
  59
  60 typedef struct {
  61  SV *comp;
  62  SV *exec;
  63 #if REP_WORKAROUND_REQUIRE_PROPAGATION
  64  IV  require_tag;
  65 #endif
  66 } rep_hint_t;
  67
  68 #if REP_THREADSAFE
  69
  70 #define PTABLE_VAL_FREE(V) { \
  71  rep_hint_t *h = (V);        \
  72  SvREFCNT_dec(h->comp);      \
  73  SvREFCNT_dec(h->exec);      \
  74  PerlMemShared_free(h);      \
  75 }
  76
  77 #define pPTBL  pTHX
  78 #define pPTBL_ pTHX_
  79 #define aPTBL  aTHX
  80 #define aPTBL_ aTHX_
  81
  82 #include "ptable.h"
  83
  84 #define ptable_store(T, K, V) ptable_store(aTHX_ (T), (K), (V))
  85 #define ptable_free(T)        ptable_free(aTHX_ (T))
  86
  87 #define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
  88
  89 typedef struct {
  90  ptable *tbl;
  91  tTHX    owner;
  92 } my_cxt_t;
  93
  94 START_MY_CXT
  95
  96 typedef struct {
  97  ptable *tbl;
  98 #if REP_HAS_PERL(5, 13, 2)
  99  CLONE_PARAMS *params;
 100 #else
 101  CLONE_PARAMS params;
 102 #endif
 103 } rep_ptable_clone_ud;
 104
 105 #if REP_HAS_PERL(5, 13, 2)
 106 # define rep_ptable_clone_ud_init(U, T, O) \
 107    (U).tbl    = (T); \
 108    (U).params = Perl_clone_params_new((O), aTHX)
 109 # define rep_ptable_clone_ud_deinit(U) Perl_clone_params_del((U).params)
 110 # define rep_dup_inc(S, U)             SvREFCNT_inc(sv_dup((S), (U)->params))
 111 #else
 112 # define rep_ptable_clone_ud_init(U, T, O) \
 113    (U).tbl               = (T);     \
 114    (U).params.stashes    = newAV(); \
 115    (U).params.flags      = 0;       \
 116    (U).params.proto_perl = (O)
 117 # define rep_ptable_clone_ud_deinit(U) SvREFCNT_dec((U).params.stashes)
 118 # define rep_dup_inc(S, U)             SvREFCNT_inc(sv_dup((S), &((U)->params)))
 119 #endif
 120
 121 STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
 122  rep_ptable_clone_ud *ud = ud_;
 123  rep_hint_t *h1 = ent->val;
 124  rep_hint_t *h2;
 125
 126  h2              = PerlMemShared_malloc(sizeof *h2);
 127  h2->comp        = rep_dup_inc(h1->comp, ud);
 128  h2->exec        = rep_dup_inc(h1->exec, ud);
 129 #if REP_WORKAROUND_REQUIRE_PROPAGATION
 130  h2->require_tag = PTR2IV(rep_dup_inc(INT2PTR(SV *, h1->require_tag), ud));
 131 #endif
 132
 133  ptable_store(ud->tbl, ent->key, h2);
 134 }
 135
 136 #include "reap.h"
 137
 138 STATIC void rep_thread_cleanup(pTHX_ void *ud) {
 139  dMY_CXT;
 140
 141  ptable_free(MY_CXT.tbl);
 142 }
 143
 144 #endif /* REP_THREADSAFE */
 145
 146 STATIC SV *rep_validate_callback(SV *code) {
 147  if (!SvROK(code))
 148   return NULL;
 149
 150  code = SvRV(code);
 151  if (SvTYPE(code) < SVt_PVCV)
 152   return NULL;
 153
 154  return SvREFCNT_inc_simple_NN(code);
 155 }
 156
 157 #if REP_WORKAROUND_REQUIRE_PROPAGATION
 158 STATIC IV rep_require_tag(pTHX) {
 159 #define rep_require_tag() rep_require_tag(aTHX)
 160  const CV *cv, *outside;
 161
 162  cv = PL_compcv;
 163
 164  if (!cv) {
 165   /* If for some reason the pragma is operational at run-time, try to discover
 166    * the current cv in use. */
 167   const PERL_SI *si;
 168
 169   for (si = PL_curstackinfo; si; si = si->si_prev) {
 170    I32 cxix;
 171
 172    for (cxix = si->si_cxix; cxix >= 0; --cxix) {
 173     const PERL_CONTEXT *cx = si->si_cxstack + cxix;
 174
 175     switch (CxTYPE(cx)) {
 176      case CXt_SUB:
 177      case CXt_FORMAT:
 178       /* The propagation workaround is only needed up to 5.10.0 and at that
 179        * time format and sub contexts were still identical. And even later the
 180        * cv members offsets should have been kept the same. */
 181       cv = cx->blk_sub.cv;
 182       goto get_enclosing_cv;
 183      case CXt_EVAL:
 184       cv = cx->blk_eval.cv;
 185       goto get_enclosing_cv;
 186      default:
 187       break;
 188     }
 189    }
 190   }
 191
 192   cv = PL_main_cv;
 193  }
 194
 195 get_enclosing_cv:
 196  for (outside = CvOUTSIDE(cv); outside; outside = CvOUTSIDE(cv))
 197   cv = outside;
 198
 199  return PTR2IV(cv);
 200 }
 201 #endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */
 202
 203 STATIC SV *rep_tag(pTHX_ SV *comp, SV *exec) {
 204 #define rep_tag(C, E) rep_tag(aTHX_ (C), (E))
 205  rep_hint_t *h;
 206  dMY_CXT;
 207
 208  h              = PerlMemShared_malloc(sizeof *h);
 209  h->comp        = rep_validate_callback(comp);
 210  h->exec        = rep_validate_callback(exec);
 211 #if REP_WORKAROUND_REQUIRE_PROPAGATION
 212  h->require_tag = rep_require_tag();
 213 #endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */
 214
 215 #if REP_THREADSAFE
 216  {
 217   dMY_CXT;
 218   /* We only need for the key to be an unique tag for looking up the value later
 219    * Allocated memory provides convenient unique identifiers, so that's why we
 220    * use the hint as the key itself. */
 221   ptable_store(MY_CXT.tbl, h, h);
 222  }
 223 #endif /* REP_THREADSAFE */
 224
 225  return newSViv(PTR2IV(h));
 226 }
 227
 228 STATIC const rep_hint_t *rep_detag(pTHX_ const SV *hint) {
 229 #define rep_detag(H) rep_detag(aTHX_ (H))
 230  rep_hint_t *h;
 231
 232  if (!(hint && SvIOK(hint)))
 233   return NULL;
 234
 235  h = INT2PTR(rep_hint_t *, SvIVX(hint));
 236 #if REP_THREADSAFE
 237  {
 238   dMY_CXT;
 239   h = ptable_fetch(MY_CXT.tbl, h);
 240  }
 241 #endif /* REP_THREADSAFE */
 242
 243 #if REP_WORKAROUND_REQUIRE_PROPAGATION
 244  if (rep_require_tag() != h->require_tag)
 245   return NULL;
 246 #endif /* REP_WORKAROUND_REQUIRE_PROPAGATION */
 247
 248  return h;
 249 }
 250
 251 STATIC U32 rep_hash = 0;
 252
 253 STATIC const rep_hint_t *rep_hint(pTHX) {
 254 #define rep_hint() rep_hint(aTHX)
 255  SV *hint;
 256
 257 #ifdef cop_hints_fetch_pvn
 258  hint = cop_hints_fetch_pvn(PL_curcop,
 259                             __PACKAGE__, __PACKAGE_LEN__, rep_hash, 0);
 260 #else
 261  /* We already require 5.9.5 for the regexp engine API. */
 262  hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
 263                                        NULL,
 264                                        __PACKAGE__, __PACKAGE_LEN__,
 265                                        0,
 266                                        rep_hash);
 267 #endif
 268
 269  return rep_detag(hint);
 270 }
 271
 272 REGEXP *
 273 #if PERL_VERSION <= 10
 274 Plugin_comp(pTHX_ const SV * const pattern, const U32 flags)
 275 #else
 276 Plugin_comp(pTHX_ SV * const pattern, U32 flags)
 277 #endif
 278 {
 279     dSP;
 280     struct regexp * rx;
 281     REGEXP *RX;
 282
 283     re__engine__Plugin re;
 284     const rep_hint_t *h;
 285
 286     STRLEN plen;
 287     char *pbuf;
 288
 289     SV *obj;
 290
 291     h = rep_hint();
 292     if (!h) /* This looks like a pragma leak. Apply the default behaviour */
 293         return re_compile(pattern, flags);
 294
 295     /* exp/xend version of the pattern & length */
 296     pbuf = SvPV((SV*)pattern, plen);
 297
 298     /* Our blessed object */
 299     obj = newSV(0);
 300     SvREFCNT_inc_simple_void_NN(obj);
 301     Newxz(re, 1, struct replug);
 302     sv_setref_pv(obj, "re::engine::Plugin", (void*)re);
 303
 304     newREGEXP(RX);
 305     rx = rxREGEXP(RX);
 306
 307     re->rx = rx;                   /* Make the rx accessible from self->rx */
 308     rx->intflags = flags;          /* Flags for internal use */
 309     rx->extflags = flags;          /* Flags for perl to use */
 310     rx->engine = RE_ENGINE_PLUGIN; /* Compile to use this engine */
 311
 312 #if PERL_VERSION <= 10
 313     rx->refcnt = 1;                /* Refcount so we won't be destroyed */
 314
 315     /* Precompiled pattern for pp_regcomp to use */
 316     rx->prelen = plen;
 317     rx->precomp = savepvn(pbuf, rx->prelen);
 318
 319     /* Set up qr// stringification to be equivalent to the supplied
 320      * pattern, this should be done via overload eventually.
 321      */
 322     rx->wraplen = rx->prelen;
 323     Newx(rx->wrapped, rx->wraplen, char);
 324     Copy(rx->precomp, rx->wrapped, rx->wraplen, char);
 325 #endif
 326
 327     /* Store our private object */
 328     rx->pprivate = obj;
 329
 330     /* Store the pattern for ->pattern */
 331     re->pattern = (SV*)pattern;
 332     SvREFCNT_inc_simple_void(re->pattern);
 333
 334     /* If there's an exec callback, store it into the private object so
 335      * that it will be the one to be called, even if the engine changes
 336      * in between */
 337     if (h->exec) {
 338         re->cb_exec = h->exec;
 339         SvREFCNT_inc_simple_void_NN(h->exec);
 340     }
 341
 342     re->cb_num_capture_buff_FETCH  = NULL;
 343     re->cb_num_capture_buff_STORE  = NULL;
 344     re->cb_num_capture_buff_LENGTH = NULL;
 345
 346     /* Call our callback function if one was defined, if not we've
 347      * already set up all the stuff we're going to to need for
 348      * subsequent exec and other calls */
 349     if (h->comp) {
 350         ENTER;
 351         SAVETMPS;
 352
 353         PUSHMARK(SP);
 354         XPUSHs(obj);
 355         PUTBACK;
 356
 357         call_sv(h->comp, G_DISCARD);
 358
 359         FREETMPS;
 360         LEAVE;
 361     }
 362
 363     /* If any of the comp-time accessors were called we'll have to
 364      * update the regexp struct with the new info.
 365      */
 366
 367     Newxz(rx->offs, rx->nparens + 1, regexp_paren_pair);
 368
 369     return RX;
 370 }
 371
 372 I32
 373 Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
 374             char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
 375 {
 376     dSP;
 377     I32 matched;
 378     struct regexp *rx = rxREGEXP(RX);
 379     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 380
 381     if (self->cb_exec) {
 382         SV *ret;
 383
 384         /* Store the current str for ->str */
 385         SvREFCNT_dec(self->str);
 386         self->str = sv;
 387         SvREFCNT_inc_simple_void(self->str);
 388
 389         ENTER;
 390         SAVETMPS;
 391
 392         PUSHMARK(SP);
 393         XPUSHs(rx->pprivate);
 394         XPUSHs(sv);
 395         PUTBACK;
 396
 397         call_sv(self->cb_exec, G_SCALAR);
 398
 399         SPAGAIN;
 400
 401         ret = POPs;
 402         if (SvTRUE(ret))
 403             matched = 1;
 404         else
 405             matched = 0;
 406
 407         PUTBACK;
 408         FREETMPS;
 409         LEAVE;
 410     } else {
 411         matched = 0;
 412     }
 413
 414     return matched;
 415 }
 416
 417 char *
 418 Plugin_intuit(pTHX_ REGEXP * const RX, SV *sv, char *strpos,
 419                      char *strend, U32 flags, re_scream_pos_data *data)
 420 {
 421     PERL_UNUSED_ARG(RX);
 422     PERL_UNUSED_ARG(sv);
 423     PERL_UNUSED_ARG(strpos);
 424     PERL_UNUSED_ARG(strend);
 425     PERL_UNUSED_ARG(flags);
 426     PERL_UNUSED_ARG(data);
 427     return NULL;
 428 }
 429
 430 SV *
 431 Plugin_checkstr(pTHX_ REGEXP * const RX)
 432 {
 433     PERL_UNUSED_ARG(RX);
 434     return NULL;
 435 }
 436
 437 void
 438 Plugin_free(pTHX_ REGEXP * const RX)
 439 {
 440     struct regexp *rx = rxREGEXP(RX);
 441     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 442
 443     SvREFCNT_dec(self->pattern);
 444     SvREFCNT_dec(self->str);
 445
 446     SvREFCNT_dec(self->cb_exec);
 447
 448     SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
 449     SvREFCNT_dec(self->cb_num_capture_buff_STORE);
 450     SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
 451
 452     self->rx = NULL;
 453     Safefree(self);
 454
 455 /*
 456     dSP;
 457     SV * callback;
 458
 459     callback = self->cb_free;
 460
 461     if (callback) {
 462         ENTER;
 463         SAVETMPS;
 464
 465         PUSHMARK(SP);
 466         XPUSHs(rx->pprivate);
 467         PUTBACK;
 468
 469         call_sv(callback, G_DISCARD);
 470
 471         PUTBACK;
 472         FREETMPS;
 473         LEAVE;
 474     }
 475     return;
 476 */
 477 }
 478
 479 void *
 480 Plugin_dupe(pTHX_ REGEXP * const RX, CLONE_PARAMS *param)
 481 {
 482     struct regexp *rx = rxREGEXP(RX);
 483     Perl_croak(aTHX_ "dupe not supported yet");
 484     return rx->pprivate;
 485 }
 486
 487
 488 void
 489 Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const RX, const I32 paren,
 490                            SV * const sv)
 491 {
 492     dSP;
 493     I32 items;
 494     SV * callback;
 495     struct regexp *rx = rxREGEXP(RX);
 496     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 497
 498     callback = self->cb_num_capture_buff_FETCH;
 499
 500     if (callback) {
 501         ENTER;
 502         SAVETMPS;
 503
 504         PUSHMARK(SP);
 505         XPUSHs(rx->pprivate);
 506         XPUSHs(sv_2mortal(newSViv(paren)));
 507         PUTBACK;
 508
 509         items = call_sv(callback, G_SCALAR);
 510
 511         if (items == 1) {
 512             SV *ret;
 513
 514             SPAGAIN;
 515             ret = POPs;
 516             sv_setsv(sv, ret);
 517         } else {
 518             sv_setsv(sv, &PL_sv_undef);
 519         }
 520
 521         PUTBACK;
 522         FREETMPS;
 523         LEAVE;
 524     } else {
 525         sv_setsv(sv, &PL_sv_undef);
 526     }
 527 }
 528
 529 void
 530 Plugin_numbered_buff_STORE(pTHX_ REGEXP * const RX, const I32 paren,
 531                            SV const * const value)
 532 {
 533     dSP;
 534     SV * callback;
 535     struct regexp *rx = rxREGEXP(RX);
 536     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 537
 538     callback = self->cb_num_capture_buff_STORE;
 539
 540     if (callback) {
 541         ENTER;
 542         SAVETMPS;
 543
 544         PUSHMARK(SP);
 545         XPUSHs(rx->pprivate);
 546         XPUSHs(sv_2mortal(newSViv(paren)));
 547         XPUSHs((SV *) value);
 548         PUTBACK;
 549
 550         call_sv(callback, G_DISCARD);
 551
 552         PUTBACK;
 553         FREETMPS;
 554         LEAVE;
 555     }
 556 }
 557
 558 I32
 559 Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv,
 560                               const I32 paren)
 561 {
 562     dSP;
 563     SV * callback;
 564     struct regexp *rx = rxREGEXP(RX);
 565     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 566
 567     callback = self->cb_num_capture_buff_LENGTH;
 568
 569     if (callback) {
 570         IV ret;
 571
 572         ENTER;
 573         SAVETMPS;
 574
 575         PUSHMARK(SP);
 576         XPUSHs(rx->pprivate);
 577         XPUSHs(sv_2mortal(newSViv(paren)));
 578         PUTBACK;
 579
 580         call_sv(callback, G_SCALAR);
 581
 582         SPAGAIN;
 583
 584         ret = POPi;
 585
 586         PUTBACK;
 587         FREETMPS;
 588         LEAVE;
 589
 590         return (I32)ret;
 591     } else {
 592         /* TODO: call FETCH and get the length on that value */
 593         return 0;
 594     }
 595 }
 596
 597
 598 SV*
 599 Plugin_named_buff (pTHX_ REGEXP * const RX, SV * const key, SV * const value,
 600                    const U32 flags)
 601 {
 602     return NULL;
 603 }
 604
 605 SV*
 606 Plugin_named_buff_iter (pTHX_ REGEXP * const RX, const SV * const lastkey,
 607                         const U32 flags)
 608 {
 609     return NULL;
 610 }
 611
 612 SV*
 613 Plugin_package(pTHX_ REGEXP * const RX)
 614 {
 615     PERL_UNUSED_ARG(RX);
 616     return newSVpvs("re::engine::Plugin");
 617 }
 618
 619 #if REP_THREADSAFE
 620
 621 STATIC U32 rep_initialized = 0;
 622
 623 STATIC void rep_teardown(pTHX_ void *root) {
 624  if (!rep_initialized || aTHX != root)
 625   return;
 626
 627  {
 628   dMY_CXT;
 629   ptable_free(MY_CXT.tbl);
 630  }
 631
 632  rep_initialized = 0;
 633 }
 634
 635 STATIC void rep_setup(pTHX) {
 636 #define rep_setup() rep_setup(aTHX)
 637  if (rep_initialized)
 638   return;
 639
 640  {
 641   MY_CXT_INIT;
 642   MY_CXT.tbl   = ptable_new();
 643   MY_CXT.owner = aTHX;
 644  }
 645
 646  call_atexit(rep_teardown, aTHX);
 647
 648  rep_initialized = 1;
 649 }
 650
 651 #else  /*  REP_THREADSAFE */
 652
 653 #define rep_setup()
 654
 655 #endif /* !REP_THREADSAFE */
 656
 657 STATIC U32 rep_booted = 0;
 658
 659 /* --- XS ------------------------------------------------------------------ */
 660
 661 MODULE = re::engine::Plugin       PACKAGE = re::engine::Plugin
 662
 663 PROTOTYPES: DISABLE
 664
 665 BOOT:
 666 {
 667     if (!rep_booted++) {
 668         PERL_HASH(rep_hash, __PACKAGE__, __PACKAGE_LEN__);
 669     }
 670
 671     rep_setup();
 672 }
 673
 674 #if REP_THREADSAFE
 675
 676 void
 677 CLONE(...)
 678 PREINIT:
 679     ptable *t;
 680 PPCODE:
 681     {
 682         rep_ptable_clone_ud ud;
 683         dMY_CXT;
 684
 685         t = ptable_new();
 686         rep_ptable_clone_ud_init(ud, t, MY_CXT.owner);
 687         ptable_walk(MY_CXT.tbl, rep_ptable_clone, &ud);
 688         rep_ptable_clone_ud_deinit(ud);
 689     }
 690     {
 691         MY_CXT_CLONE;
 692         MY_CXT.tbl   = t;
 693         MY_CXT.owner = aTHX;
 694     }
 695     reap(3, rep_thread_cleanup, NULL);
 696     XSRETURN(0);
 697
 698 #endif /* REP_THREADSAFE */
 699
 700 void
 701 pattern(re::engine::Plugin self, ...)
 702 PPCODE:
 703     XPUSHs(self->pattern);
 704
 705 void
 706 str(re::engine::Plugin self, ...)
 707 PPCODE:
 708     XPUSHs(self->str);
 709
 710 void
 711 mod(re::engine::Plugin self)
 712 PREINIT:
 713     U32 flags;
 714     char mods[5 + 1];
 715     int n = 0, i;
 716 PPCODE:
 717     flags = self->rx->intflags;
 718     if (flags & PMf_FOLD)         /* /i */
 719         mods[n++] = 'i';
 720     if (flags & PMf_MULTILINE)    /* /m */
 721         mods[n++] = 'm';
 722     if (flags & PMf_SINGLELINE)   /* /s */
 723         mods[n++] = 's';
 724     if (flags & PMf_EXTENDED)     /* /x */
 725         mods[n++] = 'x';
 726     if (flags & RXf_PMf_KEEPCOPY) /* /p */
 727         mods[n++] = 'p';
 728     mods[n] = '\0';
 729     EXTEND(SP, 2 * n);
 730     for (i = 0; i < n; ++i) {
 731         mPUSHp(mods + i, 1);
 732         PUSHs(&PL_sv_yes);
 733     }
 734     XSRETURN(2 * n);
 735
 736 void
 737 stash(re::engine::Plugin self, ...)
 738 PPCODE:
 739     if (items > 1) {
 740         SvREFCNT_dec(self->stash);
 741         self->stash = ST(1);
 742         SvREFCNT_inc_simple_void(self->stash);
 743         XSRETURN_EMPTY;
 744     } else {
 745         XPUSHs(self->stash);
 746     }
 747
 748 void
 749 minlen(re::engine::Plugin self, ...)
 750 PPCODE:
 751     if (items > 1) {
 752         self->rx->minlen = (I32)SvIV(ST(1));
 753         XSRETURN_EMPTY;
 754     } else {
 755         if (self->rx->minlen) {
 756             XPUSHs(sv_2mortal(newSViv(self->rx->minlen)));
 757         } else {
 758             XPUSHs(sv_2mortal(&PL_sv_undef));
 759         }
 760     }
 761
 762 void
 763 gofs(re::engine::Plugin self, ...)
 764 PPCODE:
 765     if (items > 1) {
 766         self->rx->gofs = (U32)SvIV(ST(1));
 767         XSRETURN_EMPTY;
 768     } else {
 769         if (self->rx->gofs) {
 770             XPUSHs(sv_2mortal(newSVuv(self->rx->gofs)));
 771         } else {
 772             XPUSHs(sv_2mortal(&PL_sv_undef));
 773         }
 774     }
 775
 776 void
 777 nparens(re::engine::Plugin self, ...)
 778 PPCODE:
 779     if (items > 1) {
 780         self->rx->nparens = (U32)SvIV(ST(1));
 781         XSRETURN_EMPTY;
 782     } else {
 783         if (self->rx->nparens) {
 784             XPUSHs(sv_2mortal(newSVuv(self->rx->nparens)));
 785         } else {
 786             XPUSHs(sv_2mortal(&PL_sv_undef));
 787         }
 788     }
 789
 790 void
 791 _exec(re::engine::Plugin self, ...)
 792 PPCODE:
 793     if (items > 1) {
 794         SvREFCNT_dec(self->cb_exec);
 795         self->cb_exec = ST(1);
 796         SvREFCNT_inc_simple_void(self->cb_exec);
 797     }
 798
 799 void
 800 _num_capture_buff_FETCH(re::engine::Plugin self, ...)
 801 PPCODE:
 802     if (items > 1) {
 803         SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
 804         self->cb_num_capture_buff_FETCH = ST(1);
 805         SvREFCNT_inc_simple_void(self->cb_num_capture_buff_FETCH);
 806     }
 807
 808 void
 809 _num_capture_buff_STORE(re::engine::Plugin self, ...)
 810 PPCODE:
 811     if (items > 1) {
 812         SvREFCNT_dec(self->cb_num_capture_buff_STORE);
 813         self->cb_num_capture_buff_STORE = ST(1);
 814         SvREFCNT_inc_simple_void(self->cb_num_capture_buff_STORE);
 815     }
 816
 817 void
 818 _num_capture_buff_LENGTH(re::engine::Plugin self, ...)
 819 PPCODE:
 820     if (items > 1) {
 821         SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
 822         self->cb_num_capture_buff_LENGTH = ST(1);
 823         SvREFCNT_inc_simple_void(self->cb_num_capture_buff_LENGTH);
 824     }
 825
 826 SV *
 827 _tag(SV *comp, SV *exec)
 828 CODE:
 829     RETVAL = rep_tag(comp, exec);
 830 OUTPUT:
 831     RETVAL
 832
 833 void
 834 ENGINE()
 835 PPCODE:
 836     XPUSHs(sv_2mortal(newSViv(PTR2IV(&engine_plugin))));