X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Plugin.xs;h=04557561946bfad91e7bce3bef0cd3bbd72849a9;hb=24c4ef9bba54bcbaecc3cc15bbc6b3fe866a1c63;hp=d64951ea73016f3fcdc3a5dec3d0404c43246b0a;hpb=1780282616fa174a9ebad39f0ecf797ebc9a3cb8;p=perl%2Fmodules%2Fre-engine-Plugin.git

diff --git a/Plugin.xs b/Plugin.xs
index d64951e..0455756 100644
--- a/Plugin.xs
+++ b/Plugin.xs
@@ -13,20 +13,6 @@
 
 #define REP_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
 
-#undef ENTERn
-#if defined(ENTER_with_name) && !REP_HAS_PERL(5, 11, 4)
-# define ENTERn(N) ENTER_with_name(N)
-#else
-# define ENTERn(N) ENTER
-#endif
-
-#undef LEAVEn
-#if defined(LEAVE_with_name) && !REP_HAS_PERL(5, 11, 4)
-# define LEAVEn(N) LEAVE_with_name(N)
-#else
-# define LEAVEn(N) LEAVE
-#endif
-
 #ifndef REP_WORKAROUND_REQUIRE_PROPAGATION
 # define REP_WORKAROUND_REQUIRE_PROPAGATION !REP_HAS_PERL(5, 10, 1)
 #endif
@@ -127,7 +113,7 @@ STATIC SV *rep_clone(pTHX_ SV *sv, tTHX owner) {
   SvREFCNT_dec(stashes);
  }
 
- return SvREFCNT_inc(dupsv);
+ return SvREFCNT_inc_simple(dupsv);
 }
 
 STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
@@ -140,9 +126,9 @@ STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
 
  h2        = PerlMemShared_malloc(sizeof *h2);
  h2->comp  = rep_clone(h1->comp, ud->owner);
- SvREFCNT_inc(h2->comp);
+ SvREFCNT_inc_simple_void(h2->comp);
  h2->exec  = rep_clone(h1->exec, ud->owner);
- SvREFCNT_inc(h2->exec);
+ SvREFCNT_inc_simple_void(h2->exec);
 #if REP_WORKAROUND_REQUIRE_PROPAGATION
  h2->cxreq = h1->cxreq;
 #endif
@@ -150,21 +136,12 @@ STATIC void rep_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  ptable_store(ud->tbl, ent->key, h2);
 }
 
-STATIC void rep_thread_cleanup(pTHX_ void *);
+#include "reap.h"
 
 STATIC void rep_thread_cleanup(pTHX_ void *ud) {
- int *level = ud;
-
- if (*level) {
-  *level = 0;
-  LEAVE;
-  SAVEDESTRUCTOR_X(rep_thread_cleanup, level);
-  ENTER;
- } else {
-  dMY_CXT;
-  PerlMemShared_free(level);
-  ptable_free(MY_CXT.tbl);
- }
+ dMY_CXT;
+
+ ptable_free(MY_CXT.tbl);
 }
 
 #endif /* REP_THREADSAFE */
@@ -249,12 +226,17 @@ STATIC const rep_hint_t *rep_hint(pTHX) {
 #define rep_hint() rep_hint(aTHX)
  SV *hint;
 
+#ifdef cop_hints_fetch_pvn
+ hint = cop_hints_fetch_pvn(PL_curcop,
+                            __PACKAGE__, __PACKAGE_LEN__, rep_hash, 0);
+#else
  /* We already require 5.9.5 for the regexp engine API. */
  hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
                                        NULL,
                                        __PACKAGE__, __PACKAGE_LEN__,
                                        0,
                                        rep_hash);
+#endif
 
  return rep_detag(hint);
 }
@@ -269,21 +251,25 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags)
     dSP;
     struct regexp * rx;
     REGEXP *RX;
-    I32 buffers;
+
     re__engine__Plugin re;
     const rep_hint_t *h;
 
+    STRLEN plen;
+    char *pbuf;
+
+    SV *obj;
+
     h = rep_hint();
     if (!h) /* This looks like a pragma leak. Apply the default behaviour */
         return re_compile(pattern, flags);
 
     /* exp/xend version of the pattern & length */
-    STRLEN plen;
-    char*  exp = SvPV((SV*)pattern, plen);
+    pbuf = SvPV((SV*)pattern, plen);
 
     /* Our blessed object */
-    SV *obj = newSV(0);
-    SvREFCNT_inc(obj);
+    obj = newSV(0);
+    SvREFCNT_inc_simple_void_NN(obj);
     Newxz(re, 1, struct replug);
     sv_setref_pv(obj, "re::engine::Plugin", (void*)re);
 
@@ -300,7 +286,7 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags)
 
     /* Precompiled pattern for pp_regcomp to use */
     rx->prelen = plen;
-    rx->precomp = savepvn(exp, rx->prelen);
+    rx->precomp = savepvn(pbuf, rx->prelen);
 
     /* Set up qr// stringification to be equivalent to the supplied
      * pattern, this should be done via overload eventually.
@@ -315,14 +301,14 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags)
 
     /* Store the pattern for ->pattern */
     re->pattern = (SV*)pattern;
-    SvREFCNT_inc(re->pattern);
+    SvREFCNT_inc_simple_void(re->pattern);
 
     /* If there's an exec callback, store it into the private object so
      * that it will be the one to be called, even if the engine changes
      * in between */
     if (h->exec) {
         re->cb_exec = h->exec;
-	SvREFCNT_inc_simple_void_NN(h->exec);
+        SvREFCNT_inc_simple_void_NN(h->exec);
     }
 
     re->cb_num_capture_buff_FETCH  = NULL;
@@ -350,9 +336,7 @@ Plugin_comp(pTHX_ SV * const pattern, U32 flags)
      * update the regexp struct with the new info.
      */
 
-    buffers = rx->nparens;
-
-    Newxz(rx->offs, buffers + 1, regexp_paren_pair);
+    Newxz(rx->offs, rx->nparens + 1, regexp_paren_pair);
 
     return RX;
 }
@@ -367,9 +351,12 @@ Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
     GET_SELF_FROM_PPRIVATE(rx->pprivate);
 
     if (self->cb_exec) {
+        SV *ret;
+
         /* Store the current str for ->str */
-        self->str = (SV*)sv;
-        SvREFCNT_inc(self->str);
+        SvREFCNT_dec(self->str);
+        self->str = sv;
+        SvREFCNT_inc_simple_void(self->str);
 
         ENTER;
         SAVETMPS;
@@ -383,8 +370,7 @@ Plugin_exec(pTHX_ REGEXP * const RX, char *stringarg, char *strend,
  
         SPAGAIN;
 
-        SV * ret = POPs;
-
+        ret = POPs;
         if (SvTRUE(ret))
             matched = 1;
         else
@@ -495,9 +481,10 @@ Plugin_numbered_buff_FETCH(pTHX_ REGEXP * const RX, const I32 paren,
         items = call_sv(callback, G_SCALAR);
         
         if (items == 1) {
-            SPAGAIN;
+            SV *ret;
 
-            SV * ret = POPs;
+            SPAGAIN;
+            ret = POPs;
             sv_setsv(sv, ret);
         } else {
             sv_setsv(sv, &PL_sv_undef);
@@ -529,7 +516,7 @@ Plugin_numbered_buff_STORE(pTHX_ REGEXP * const RX, const I32 paren,
         PUSHMARK(SP);
         XPUSHs(rx->pprivate);
         XPUSHs(sv_2mortal(newSViv(paren)));
-        XPUSHs(SvREFCNT_inc((SV *) value));
+        XPUSHs((SV *) value);
         PUTBACK;
 
         call_sv(callback, G_DISCARD);
@@ -552,6 +539,8 @@ Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv,
     callback = self->cb_num_capture_buff_LENGTH;
 
     if (callback) {
+        IV ret;
+
         ENTER;
         SAVETMPS;
    
@@ -564,7 +553,7 @@ Plugin_numbered_buff_LENGTH(pTHX_ REGEXP * const RX, const SV * const sv,
 
         SPAGAIN;
 
-        IV ret = POPi;
+        ret = POPi;
 
         PUTBACK;
         FREETMPS;
@@ -638,7 +627,7 @@ STATIC U32 rep_booted = 0;
 
 /* --- XS ------------------------------------------------------------------ */
 
-MODULE = re::engine::Plugin	PACKAGE = re::engine::Plugin
+MODULE = re::engine::Plugin       PACKAGE = re::engine::Plugin
 
 PROTOTYPES: DISABLE
 
@@ -657,29 +646,23 @@ void
 CLONE(...)
 PREINIT:
     ptable *t;
-    int    *level;
-CODE:
-    {
-	my_cxt_t ud;
-	dMY_CXT;
-	ud.tbl   = t = ptable_new();
-	ud.owner = MY_CXT.owner;
-	ptable_walk(MY_CXT.tbl, rep_ptable_clone, &ud);
-    }
+PPCODE:
     {
-	MY_CXT_CLONE;
-	MY_CXT.tbl   = t;
-	MY_CXT.owner = aTHX;
+        my_cxt_t ud;
+        dMY_CXT;
+        ud.tbl   = t = ptable_new();
+        ud.owner = MY_CXT.owner;
+        ptable_walk(MY_CXT.tbl, rep_ptable_clone, &ud);
     }
     {
-	level = PerlMemShared_malloc(sizeof *level);
-	*level = 1;
-	LEAVEn("sub");
-	SAVEDESTRUCTOR_X(rep_thread_cleanup, level);
-	ENTERn("sub");
+        MY_CXT_CLONE;
+        MY_CXT.tbl   = t;
+        MY_CXT.owner = aTHX;
     }
+    reap(3, rep_thread_cleanup, NULL);
+    XSRETURN(0);
 
-#endif
+#endif /* REP_THREADSAFE */
 
 void
 pattern(re::engine::Plugin self, ...)
@@ -691,45 +674,39 @@ str(re::engine::Plugin self, ...)
 PPCODE:
     XPUSHs(self->str);
 
-char*
-mod(re::engine::Plugin self, ...)
+void
+mod(re::engine::Plugin self)
+PREINIT:
+    U32 flags;
+    char mods[5 + 1];
+    int n = 0, i;
 PPCODE:
-    /* /i */
-    if (self->rx->intflags & PMf_FOLD) {
-      XPUSHs(sv_2mortal(newSVpvs("i")));
-      XPUSHs(&PL_sv_yes);
-    }
-
-    /* /m */
-    if (self->rx->intflags & PMf_MULTILINE) {
-      XPUSHs(sv_2mortal(newSVpvs("m")));
-      XPUSHs(&PL_sv_yes);
-    }
-
-    /* /s */
-    if (self->rx->intflags & PMf_SINGLELINE) {
-      XPUSHs(sv_2mortal(newSVpvs("s")));
-      XPUSHs(&PL_sv_yes);
-    }
-
-    /* /x */
-    if (self->rx->intflags & PMf_EXTENDED) {
-      XPUSHs(sv_2mortal(newSVpvs("x")));
-      XPUSHs(&PL_sv_yes);
-    }
-
-    /* /p */
-    if (self->rx->intflags & RXf_PMf_KEEPCOPY) {
-      XPUSHs(sv_2mortal(newSVpvs("p")));
-      XPUSHs(&PL_sv_yes);
+    flags = self->rx->intflags;
+    if (flags & PMf_FOLD)         /* /i */
+        mods[n++] = 'i';
+    if (flags & PMf_MULTILINE)    /* /m */
+        mods[n++] = 'm';
+    if (flags & PMf_SINGLELINE)   /* /s */
+        mods[n++] = 's';
+    if (flags & PMf_EXTENDED)     /* /x */
+        mods[n++] = 'x';
+    if (flags & RXf_PMf_KEEPCOPY) /* /p */
+        mods[n++] = 'p';
+    mods[n] = '\0';
+    EXTEND(SP, 2 * n);
+    for (i = 0; i < n; ++i) {
+        mPUSHp(mods + i, 1);
+        PUSHs(&PL_sv_yes);
     }
+    XSRETURN(2 * n);
 
 void
 stash(re::engine::Plugin self, ...)
 PPCODE:
     if (items > 1) {
+        SvREFCNT_dec(self->stash);
         self->stash = ST(1);
-        SvREFCNT_inc(self->stash);
+        SvREFCNT_inc_simple_void(self->stash);
         XSRETURN_EMPTY;
     } else {
         XPUSHs(self->stash);
@@ -783,7 +760,7 @@ PPCODE:
     if (items > 1) {
         SvREFCNT_dec(self->cb_exec);
         self->cb_exec = ST(1);
-        SvREFCNT_inc(self->cb_exec);
+        SvREFCNT_inc_simple_void(self->cb_exec);
     }
 
 void
@@ -792,7 +769,7 @@ PPCODE:
     if (items > 1) {
         SvREFCNT_dec(self->cb_num_capture_buff_FETCH);
         self->cb_num_capture_buff_FETCH = ST(1);
-        SvREFCNT_inc(self->cb_num_capture_buff_FETCH);
+        SvREFCNT_inc_simple_void(self->cb_num_capture_buff_FETCH);
     }
 
 void
@@ -801,7 +778,7 @@ PPCODE:
     if (items > 1) {
         SvREFCNT_dec(self->cb_num_capture_buff_STORE);
         self->cb_num_capture_buff_STORE = ST(1);
-        SvREFCNT_inc(self->cb_num_capture_buff_STORE);
+        SvREFCNT_inc_simple_void(self->cb_num_capture_buff_STORE);
     }
 
 void
@@ -810,7 +787,7 @@ PPCODE:
     if (items > 1) {
         SvREFCNT_dec(self->cb_num_capture_buff_LENGTH);
         self->cb_num_capture_buff_LENGTH = ST(1);
-        SvREFCNT_inc(self->cb_num_capture_buff_LENGTH);
+        SvREFCNT_inc_simple_void(self->cb_num_capture_buff_LENGTH);
     }
 
 SV *