From: Vincent Pit <vince@profvince.com>
Date: Thu, 19 Feb 2009 16:03:18 +0000 (+0100)
Subject: Inline the 'eval' specific part of vmg_cb_call() into vmg_svt_free()
X-Git-Tag: v0.31~2
X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FVariable-Magic.git;a=commitdiff_plain;h=53e27c713731b1b22929db82f599504d22f018e5

Inline the 'eval' specific part of vmg_cb_call() into vmg_svt_free()

It has become way too specific to keep it in the common wrapper.
---

diff --git a/Magic.xs b/Magic.xs
index fd2046f..28873dd 100644
--- a/Magic.xs
+++ b/Magic.xs
@@ -564,19 +564,17 @@ STATIC SV *vmg_op_info(pTHX_ unsigned int opinfo) {
 #define VMG_CB_CALL_ARGS_MASK  15
 #define VMG_CB_CALL_ARGS_SHIFT 4
 #define VMG_CB_CALL_OPINFO     (VMG_OP_INFO_NAME|VMG_OP_INFO_OBJECT)
-#define VMG_CB_CALL_EVAL       4
 
 STATIC int vmg_cb_call(pTHX_ SV *cb, SV *sv, SV *data, unsigned int flags, ...){
  va_list ap;
  int ret;
- unsigned int i, args, opinfo, eval, has_err = 0;
+ unsigned int i, args, opinfo;
 
  dSP;
 
  args    = flags & VMG_CB_CALL_ARGS_MASK;
  flags >>= VMG_CB_CALL_ARGS_SHIFT;
  opinfo  = flags & VMG_CB_CALL_OPINFO;
- eval    = flags & VMG_CB_CALL_EVAL;
 
  ENTER;
  SAVETMPS;
@@ -595,33 +593,13 @@ STATIC int vmg_cb_call(pTHX_ SV *cb, SV *sv, SV *data, unsigned int flags, ...){
   XPUSHs(vmg_op_info(opinfo));
  PUTBACK;
 
- if (!eval) {
-  call_sv(cb, G_SCALAR);
- } else {
-  unsigned int flags   = G_SCALAR | G_EVAL;
-  unsigned int had_err = SvTRUE(ERRSV);
-  if (had_err)
-   flags |= G_KEEPERR;
-  call_sv(cb, flags);
-  has_err = SvTRUE(ERRSV);
-  if (IN_PERL_COMPILETIME && !had_err && has_err)
-   ++PL_error_count;
- }
+ call_sv(cb, G_SCALAR);
 
  VMG_CB_CALL_SET_RET(0);
 
  FREETMPS;
  LEAVE;
 
- if (has_err) {
-  /* Get the eval context that was pushed by call_sv, and fake an entry for the
-   * namesv, as die_where will need it to be non NULL later */
-  PERL_CONTEXT *cx = cxstack + cxstack_ix + 1;
-  if (!cx->blk_eval.old_namesv)
-   cx->blk_eval.old_namesv
-                 = sv_2mortal(newSVpvn_share("Variable/Magic/DUMMY.pm", 23, 0));
- }
-
  return ret;
 }
 
@@ -696,18 +674,19 @@ STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
 
 STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
  const MGWIZ *w;
- unsigned int flags;
+ unsigned int had_err, has_err, flags = G_SCALAR | G_EVAL;
  int ret = 0;
 
+ dSP;
+
  /* Don't even bother if we are in global destruction - the wizard is prisoner
   * of circular references and we are way beyond user realm */
  if (PL_dirty)
   return 0;
 
  w = SV2MGWIZ(mg->mg_ptr);
- flags = w->opinfo | VMG_CB_CALL_EVAL;
 
- /* So that it survives the temp cleanup in vmg_cb_call */
+ /* So that it survives the temp cleanup below */
  SvREFCNT_inc(sv);
 
 #if !VMG_HAS_PERL_MAINT(5, 11, 0, 32686)
@@ -717,7 +696,40 @@ STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
  SvMAGIC_set(sv, mg);
 #endif
 
- ret = vmg_cb_call1(w->cb_free, sv, mg->mg_obj);
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ EXTEND(SP, 2);
+ PUSHs(sv_2mortal(newRV_inc(sv)));
+ PUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
+ if (w->opinfo)
+  XPUSHs(vmg_op_info(w->opinfo));
+ PUTBACK;
+
+ had_err = SvTRUE(ERRSV);
+ if (had_err)
+  flags |= G_KEEPERR;
+
+ call_sv(w->cb_free, flags);
+
+ has_err = SvTRUE(ERRSV);
+ if (IN_PERL_COMPILETIME && !had_err && has_err)
+  ++PL_error_count;
+
+ VMG_CB_CALL_SET_RET(0);
+
+ FREETMPS;
+ LEAVE;
+
+ if (has_err) {
+  /* Get the eval context that was pushed by call_sv, and fake an entry for the
+   * namesv, as die_where will need it to be non NULL later */
+  PERL_CONTEXT *cx = cxstack + cxstack_ix + 1;
+  if (!cx->blk_eval.old_namesv)
+   cx->blk_eval.old_namesv
+                 = sv_2mortal(newSVpvn_share("Variable/Magic/DUMMY.pm", 23, 0));
+ }
 
  /* Calling SvREFCNT_dec() will trigger destructors in an infinite loop, so
   * we have to rely on SvREFCNT() being a lvalue. Heck, even the core does it */