]> git.vpit.fr Git - perl/modules/indirect.git/blobdiff - indirect.xs
Store a proper op info instead of hijacking a SV
[perl/modules/indirect.git] / indirect.xs
index 01e7a33441c549da35485901f97c1b7c4fb60f30..9347467ea034cad3ae3aa75631cd5a2982ae74e9 100644 (file)
 # define dNOOP
 #endif
 
+#ifndef Newx
+# define Newx(v, n, c) New(0, v, n, c)
+#endif
+
 #ifndef SvPV_const
 # define SvPV_const SvPV
 #endif
 # define sv_catpvn_nomg sv_catpvn
 #endif
 
+#ifndef mPUSHp
+# define mPUSHp(P, L) PUSHs(sv_2mortal(newSVpvn((P), (L))))
+#endif
+
 #ifndef mPUSHu
 # define mPUSHu(U) PUSHs(sv_2mortal(newSVuv(U)))
 #endif
@@ -152,8 +160,14 @@ typedef struct {
 /* Define the op->str ptable here because we need to be able to clean it during
  * thread cleanup. */
 
+typedef struct {
+ const char *pos;
+ char       *buf;
+ STRLEN      len, size;
+} indirect_op_info_t;
+
 #define PTABLE_NAME        ptable
-#define PTABLE_VAL_FREE(V) SvREFCNT_dec(V)
+#define PTABLE_VAL_FREE(V) if (V) { Safefree(((indirect_op_info_t *) (V))->buf); Safefree(V); }
 
 #define pPTBL  pTHX
 #define pPTBL_ pTHX_
@@ -183,6 +197,29 @@ START_MY_CXT
 
 #if I_THREADSAFE
 
+STATIC SV *indirect_clone(pTHX_ SV *sv, tTHX owner) {
+#define indirect_clone(S, O) indirect_clone(aTHX_ (S), (O))
+ CLONE_PARAMS  param;
+ AV           *stashes = NULL;
+ SV           *dupsv;
+
+ if (SvTYPE(sv) == SVt_PVHV && HvNAME_get(sv))
+  stashes = newAV();
+
+ param.stashes    = stashes;
+ param.flags      = 0;
+ param.proto_perl = owner;
+
+ dupsv = sv_dup(sv, &param);
+
+ if (stashes) {
+  av_undef(stashes);
+  SvREFCNT_dec(stashes);
+ }
+
+ return SvREFCNT_inc(dupsv);
+}
+
 STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
  my_cxt_t        *ud = ud_;
  indirect_hint_t *h1 = ent->val;
@@ -190,19 +227,8 @@ STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) {
 
  *h2 = *h1;
 
- if (ud->owner != aTHX) {
-  SV *val = h1->code;
-  CLONE_PARAMS param;
-  AV *stashes = (SvTYPE(val) == SVt_PVHV && HvNAME_get(val)) ? newAV() : NULL;
-  param.stashes    = stashes;
-  param.flags      = 0;
-  param.proto_perl = ud->owner;
-  h2->code = sv_dup(val, &param);
-  if (stashes) {
-   av_undef(stashes);
-   SvREFCNT_dec(stashes);
-  }
- }
+ if (ud->owner != aTHX)
+  h2->code = indirect_clone(h1->code, ud->owner);
 
  ptable_hints_store(ud->tbl, ent->key, h2);
  SvREFCNT_inc(h2->code);
@@ -344,8 +370,10 @@ STATIC SV *indirect_hint(pTHX) {
 
 STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) {
 #define indirect_map_store(O, S, N) indirect_map_store(aTHX_ (O), (S), (N))
+ indirect_op_info_t *oi;
+ const char *s;
+ STRLEN len;
  dMY_CXT;
- SV *val;
 
  /* When lex_inwhat is set, we're in a quotelike environment (qq, qr, but not q)
   * In this case the linestr has temporarly changed, but the old buffer should
@@ -359,32 +387,33 @@ STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv) {
   }
  }
 
- val = newSVsv(sv);
SvUPGRADE(val, SVt_PVIV);
SvUVX(val) = PTR2UV(src);
SvIOK_on(val);
SvIsUV_on(val);
- SvREADONLY_on(val);
+ if (!(oi = ptable_fetch(MY_CXT.map, o))) {
 Newx(oi, 1, indirect_op_info_t);
 ptable_store(MY_CXT.map, o, oi);
 oi->buf  = NULL;
 oi->size = 0;
+ }
 
- ptable_store(MY_CXT.map, o, val);
+ s = SvPV_const(sv, len);
+ if (len > oi->size) {
+  Safefree(oi->buf);
+  Newx(oi->buf, len, char);
+  oi->size = len;
+ }
+ Copy(s, oi->buf, len, char);
+ oi->len = len;
+ oi->pos = src;
 }
 
-STATIC const char *indirect_map_fetch(pTHX_ const OP *o, SV ** const name) {
-#define indirect_map_fetch(O, S) indirect_map_fetch(aTHX_ (O), (S))
+STATIC const indirect_op_info_t *indirect_map_fetch(pTHX_ const OP *o) {
+#define indirect_map_fetch(O) indirect_map_fetch(aTHX_ (O))
+ const indirect_op_info_t *val;
  dMY_CXT;
- SV *val;
 
  if (MY_CXT.linestr != SvPVX_const(PL_linestr))
   return NULL;
 
- val = ptable_fetch(MY_CXT.map, o);
- if (!val) {
-  *name = NULL;
-  return NULL;
- }
-
- *name = val;
- return INT2PTR(const char *, SvUVX(val));
+ return ptable_fetch(MY_CXT.map, o);
 }
 
 STATIC void indirect_map_delete(pTHX_ const OP *o) {
@@ -539,17 +568,23 @@ STATIC OP *(*indirect_old_ck_method)(pTHX_ OP *) = 0;
 STATIC OP *indirect_ck_method(pTHX_ OP *o) {
  if (indirect_hint()) {
   OP *op = cUNOPo->op_first;
+  const indirect_op_info_t *oi = indirect_map_fetch(op);
+  const char *s = NULL;
   SV *sv;
-  const char *s = indirect_map_fetch(op, &sv);
-  if (!s) {
+
+  if (oi && (s = oi->pos)) {
+   sv = sv_2mortal(newSVpvn(oi->buf, oi->len));
+  } else {
    sv = cSVOPx_sv(op);
    if (!SvPOK(sv) || (SvTYPE(sv) < SVt_PV))
     goto done;
    sv = sv_mortalcopy(sv);
    s  = indirect_find(sv, PL_oldbufptr);
   }
+
   o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o);
   /* o may now be a method_named */
+
   indirect_map_store(o, s, sv);
   return o;
  }
@@ -571,9 +606,8 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) {
  o = CALL_FPTR(indirect_old_ck_entersub)(aTHX_ o);
 
  if (code) {
-  const char *mpos, *opos;
-  SV *mnamesv, *onamesv;
-  OP *mop, *oop;
+  const indirect_op_info_t *moi, *ooi;
+  OP     *mop, *oop;
   LISTOP *lop;
 
   oop = o;
@@ -603,15 +637,15 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) {
   else if (mop->op_type != OP_METHOD_NAMED)
    goto done;
 
-  mpos = indirect_map_fetch(mop, &mnamesv);
-  if (!mpos)
+  moi = indirect_map_fetch(mop);
+  if (!(moi && moi->pos))
    goto done;
 
-  opos = indirect_map_fetch(oop, &onamesv);
-  if (!opos)
+  ooi = indirect_map_fetch(oop);
+  if (!(ooi && ooi->pos))
    goto done;
 
-  if (mpos < opos) {
+  if (moi->pos < ooi->pos) {
    SV     *file;
    line_t  line;
    dSP;
@@ -619,9 +653,6 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) {
    ENTER;
    SAVETMPS;
 
-   onamesv = sv_mortalcopy(onamesv);
-   mnamesv = sv_mortalcopy(mnamesv);
-
 #ifdef USE_ITHREADS
    file = sv_2mortal(newSVpv(CopFILE(&PL_compiling), 0));
 #else
@@ -631,8 +662,8 @@ STATIC OP *indirect_ck_entersub(pTHX_ OP *o) {
 
    PUSHMARK(SP);
    EXTEND(SP, 4);
-   PUSHs(onamesv);
-   PUSHs(mnamesv);
+   mPUSHp(ooi->buf, ooi->len);
+   mPUSHp(moi->buf, moi->len);
    PUSHs(file);
    mPUSHu(line);
    PUTBACK;