X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Upper.git;a=blobdiff_plain;f=Upper.xs;h=0c762de1dcb947d420bd265d01231d8cec433d7e;hp=114161a4879cd4ddfe7f13162360f09ecd0ce89e;hb=HEAD;hpb=70148496e0d2fce5974ae1a869f06b22bd7c119d

diff --git a/Upper.xs b/Upper.xs
index 114161a..7be4f69 100644
--- a/Upper.xs
+++ b/Upper.xs
@@ -653,9 +653,9 @@ static void su_save_helem(pTHX_ HV *hv, SV *keysv, SV *val) {
   return;
  }
 
- if (preeminent)
+ if (preeminent) {
   save_helem(hv, keysv, svp);
- else {
+ } else {
   STRLEN keylen;
   const char * const key = SvPV_const(keysv, keylen);
   SAVEDELETE(hv, savepvn(key, keylen),
@@ -754,7 +754,7 @@ static void su_call(pTHX_ SV *cb) {
 
  dSP;
 
- XSH_D(su_debug_log("@@@ call scope_ix=%2d save_ix=%2d\n",
+ XSH_D(xsh_debug_log("@@@ call scope_ix=%2d save_ix=%2d\n",
                           PL_scopestack_ix, PL_savestack_ix));
 
  ENTER;
@@ -808,25 +808,31 @@ typedef struct {
 
 static I32 su_ud_localize_init(pTHX_ su_ud_localize *ud, SV *sv, SV *val, SV *elem) {
 #define su_ud_localize_init(UD, S, V, E) su_ud_localize_init(aTHX_ (UD), (S), (V), (E))
- UV deref = 0;
- svtype t = SVt_NULL;
- I32 size;
+ int take_ref = 0;
+ svtype     t = SVt_NULL;
+ I32     size;
 
  SvREFCNT_inc_simple_void(sv);
 
  if (SvTYPE(sv) >= SVt_PVGV) {
+  if (SvFAKE(sv)) {
+   sv_force_normal(sv);
+   goto string_spec;
+  }
+
   if (!val || !SvROK(val)) { /* local *x; or local *x = $val; */
    t = SVt_PVGV;
   } else {                   /* local *x = \$val; */
    t = SvTYPE(SvRV(val));
-   deref = 1;
   }
  } else if (SvROK(sv)) {
   croak("Invalid %s reference as the localization target",
                  sv_reftype(SvRV(sv), 0));
  } else {
   STRLEN len, l;
-  const char *p = SvPV_const(sv, len), *s;
+  const char *p, *s;
+string_spec:
+  p = SvPV_const(sv, len);
   for (s = p, l = len; l > 0 && isSPACE(*s); ++s, --l) { }
   if (!l) {
    l = len;
@@ -842,14 +848,17 @@ static I32 su_ud_localize_init(pTHX_ su_ud_localize *ud, SV *sv, SV *val, SV *el
   if (t != SVt_NULL) {
    ++s;
    --l;
+   if (t == SVt_PV)
+    take_ref = 1;
   } else if (val) { /* t == SVt_NULL, type can't be inferred from the sigil */
    if (SvROK(val) && !sv_isobject(val)) {
     t = SvTYPE(SvRV(val));
-    deref = 1;
    } else {
     t = SvTYPE(val);
+    take_ref = 1;
    }
   }
+
   SvREFCNT_dec(sv);
   sv = newSVpvn(s, l);
  }
@@ -858,31 +867,31 @@ static I32 su_ud_localize_init(pTHX_ su_ud_localize *ud, SV *sv, SV *val, SV *el
   case SVt_PVAV:
    size  = elem ? SU_SAVE_AELEM_OR_ADELETE_SIZE
                 : SU_SAVE_ARY_SIZE;
-   deref = 0;
    break;
   case SVt_PVHV:
    size  = elem ? SU_SAVE_HELEM_OR_HDELETE_SIZE
                 : SU_SAVE_HASH_SIZE;
-   deref = 0;
    break;
   case SVt_PVGV:
    size  = SU_SAVE_GP_SIZE;
-   deref = 0;
    break;
   case SVt_PVCV:
    size  = SU_SAVE_GVCV_SIZE;
-   deref = 0;
    break;
   default:
    size = SU_SAVE_SCALAR_SIZE;
    break;
  }
- /* When deref is set, val isn't NULL */
 
  SU_UD_PRIVATE(ud) = t;
 
  ud->sv   = sv;
- ud->val  = val ? newSVsv(deref ? SvRV(val) : val) : NULL;
+ if (val) {
+  val     = newSVsv(val);
+  ud->val = take_ref ? newRV_noinc(val) : val;
+ } else {
+  ud->val = NULL;
+ }
  ud->elem = SvREFCNT_inc(elem);
 
  return size;
@@ -926,9 +935,9 @@ static void su_localize(pTHX_ void *ud_) {
  XSH_D({
   SV *z = newSV(0);
   SvUPGRADE(z, t);
-  su_debug_log("%p:     === localize a %s\n",ud, sv_reftype(z, 0));
-  su_debug_log("%p:         depth=%2d scope_ix=%2d save_ix=%2d\n",
-                ud, SU_UD_DEPTH(ud), PL_scopestack_ix, PL_savestack_ix);
+  xsh_debug_log("%p:     === localize a %s\n", ud, sv_reftype(z, 0));
+  xsh_debug_log("%p:         depth=%2d scope_ix=%2d save_ix=%2d\n",
+                 ud,   SU_UD_DEPTH(ud), PL_scopestack_ix, PL_savestack_ix);
   SvREFCNT_dec(z);
  });
 
@@ -938,15 +947,17 @@ static void su_localize(pTHX_ void *ud_) {
    if (elem) {
     su_save_aelem(GvAV(gv), elem, val);
     return;
-   } else
+   } else {
     save_ary(gv);
+   }
    break;
   case SVt_PVHV:
    if (elem) {
     su_save_helem(GvHV(gv), elem, val);
     return;
-   } else
+   } else {
     save_hash(gv);
+   }
    break;
   case SVt_PVGV:
    save_gp(gv, 1); /* hide previous entry in symtab */
@@ -955,7 +966,7 @@ static void su_localize(pTHX_ void *ud_) {
    su_save_gvcv(gv);
    break;
   default:
-   gv = (GV *) save_scalar(gv);
+   save_scalar(gv);
    break;
  }
 
@@ -1076,14 +1087,20 @@ static const int su_cxt_enter_count[] = {
 /* push at least 'size' slots worth of padding onto the savestack */
 
 static void su_ss_push_padding(pTHX_ void *ud, I32 size) {
+#define su_ss_push_padding(U, S) su_ss_push_padding(aTHX_ (U), (S))
  if (size <= 0)
   return;
+
  if (size < SU_SAVE_ALLOC_SIZE + 1) /* minimum possible SAVEt_ALLOC */
   size = SU_SAVE_ALLOC_SIZE + 1;
- XSH_D(su_debug_log(
-        "%p:     push %2d padding at save_ix=%d\n",
-         ud, size, PL_savestack_ix));
- save_alloc((size - SU_SAVE_ALLOC_SIZE)*sizeof(*PL_savestack), 0);
+
+ XSH_D(xsh_debug_log(
+       "%p:     push %2d padding at save_ix=%d\n",
+        ud,         size,      PL_savestack_ix));
+
+ save_alloc((size - SU_SAVE_ALLOC_SIZE) * sizeof(*PL_savestack), 0);
+
+ return;
 }
 
 static void su_pop(pTHX_ void *ud);
@@ -1092,17 +1109,24 @@ static void su_pop(pTHX_ void *ud);
  * first indicates that this is the first push of a destructor */
 
 static void su_ss_push_destructor(pTHX_ void *ud, I32 depth, bool first) {
+#define su_ss_push_destructor(U, D, F) su_ss_push_destructor(aTHX_ (U), (D), (F))
  su_ud_origin_elem *origin = SU_UD_ORIGIN(ud);
 
  assert(first || origin[depth+1].orig_ix == PL_savestack_ix);
- su_ss_push_padding(aTHX_ ud,
-    (origin[depth].orig_ix + origin[depth].offset) - PL_savestack_ix);
- XSH_D(su_debug_log(
-        "%p:     push destructor at save_ix=%d depth=%d scope_ix=%d\n",
-         ud, PL_savestack_ix, depth, PL_scopestack_ix));
+
+ su_ss_push_padding(ud,
+              (origin[depth].orig_ix + origin[depth].offset) - PL_savestack_ix);
+
+ XSH_D(xsh_debug_log(
+       "%p:     push destructor at save_ix=%d depth=%d scope_ix=%d\n",
+        ud,                   PL_savestack_ix,   depth, PL_scopestack_ix));
+
  SAVEDESTRUCTOR_X(su_pop, ud);
+
  assert(first ||
-        PL_savestack_ix <= origin[depth+1].orig_ix +  origin[depth+1].offset);
+        PL_savestack_ix <= origin[depth+1].orig_ix + origin[depth+1].offset);
+
+ return;
 }
 
 /* this is called during each leave_scope() via SAVEDESTRUCTOR_X */
@@ -1115,17 +1139,17 @@ static void su_pop(pTHX_ void *ud) {
  depth  = SU_UD_DEPTH(ud);
  origin = SU_UD_ORIGIN(ud);
 
- XSH_D(su_debug_log( "%p: ### su_pop: depth=%d\n", ud, depth));
+ XSH_D(xsh_debug_log("%p: ### su_pop: depth=%d\n", ud, depth));
 
  depth--;
  mark = PL_savestack_ix;
  base = origin[depth].orig_ix;
 
- XSH_D(su_debug_log("%p:     residual savestack frame is %d(+%d)..%d\n",
-                     ud, base, origin[depth].offset, mark));
+ XSH_D(xsh_debug_log("%p:     residual savestack frame is %d(+%d)..%d\n",
+                      ud,                  base, origin[depth].offset, mark));
 
  if (base < mark) {
-  XSH_D(su_debug_log("%p:     clear leftovers at %d..%d\n", ud, base, mark));
+  XSH_D(xsh_debug_log("%p:     clear leftovers at %d..%d\n", ud, base, mark));
   leave_scope(base);
  }
  assert(PL_savestack_ix == base);
@@ -1133,13 +1157,15 @@ static void su_pop(pTHX_ void *ud) {
  SU_UD_DEPTH(ud) = depth;
 
  if (depth > 0) {
-  su_ss_push_destructor(aTHX_ ud, depth-1, 0);
+  su_ss_push_destructor(ud, depth-1, 0);
  } else {
   I32 offset = origin[0].offset; /* grab value before origin is freed */
   switch (SU_UD_TYPE(ud)) {
    case SU_UD_TYPE_REAP: {
-    XSH_D(su_debug_log("%p:     === reap\n%p: depth=%d scope_ix=%d save_ix=%d\n",
-                   ud, ud, SU_UD_DEPTH(ud), PL_scopestack_ix, PL_savestack_ix));
+    XSH_D(
+     xsh_debug_log("%p:     === reap\n%p: depth=%d scope_ix=%d save_ix=%d\n",
+                    ud, ud, SU_UD_DEPTH(ud), PL_scopestack_ix, PL_savestack_ix)
+    );
     SAVEDESTRUCTOR_X(su_call, SU_UD_REAP_CB(ud));
     SU_UD_FREE(ud);
     break;
@@ -1157,30 +1183,29 @@ static void su_pop(pTHX_ void *ud) {
   if (PL_savestack_ix < base + offset) {
    I32 gap = (base + offset) - PL_savestack_ix;
    assert(gap >= SU_SAVE_ALLOC_SIZE + 1);
-   su_ss_push_padding(aTHX_ ud, gap);
+   su_ss_push_padding(ud, gap);
   }
   assert(PL_savestack_ix == base + offset);
  }
 
- XSH_D(su_debug_log("%p:     end pop: ss_ix=%d\n", ud, PL_savestack_ix));
+ XSH_D(xsh_debug_log("%p:     end pop: ss_ix=%d\n", ud, PL_savestack_ix));
 }
 
 /* --- Initialize the stack and the action userdata ------------------------ */
 
 static void su_init(pTHX_ void *ud, I32 cxix, I32 size) {
 #define su_init(U, C, S) su_init(aTHX_ (U), (C), (S))
- I32 i, depth;
  su_ud_origin_elem *origin;
- I32 cur_cx_ix;
- I32 cur_scope_ix;
+ I32                i, depth;
+ I32                cur_cx_ix, cur_scope_ix;
 
- XSH_D(su_debug_log("%p: ### su_init(cxix=%d, size=%d)\n", ud, cxix, size));
+ XSH_D(xsh_debug_log("%p: ### su_init(cxix=%d, size=%d)\n", ud, cxix, size));
 
- depth = PL_scopestack_ix - cxstack[cxix].blk_oldscopesp;
+ depth  = PL_scopestack_ix - cxstack[cxix].blk_oldscopesp;
 #if SU_HAS_NEW_CXT
  depth += (cxstack_ix - cxix); /* each context frame holds 1 scope */
 #endif
- XSH_D(su_debug_log(
+ XSH_D(xsh_debug_log(
    "%p:     going down by depth=%d with scope_ix=%d save_ix=%d\n",
     ud, depth, PL_scopestack_ix, PL_savestack_ix));
 
@@ -1227,23 +1252,23 @@ static void su_init(pTHX_ void *ud, I32 cxix, I32 size) {
 
  Newx(origin, depth, su_ud_origin_elem);
 
- cur_cx_ix  = cxix;
+ cur_cx_ix    = cxix;
  cur_scope_ix = cxstack[cxix].blk_oldscopesp;
+
 #if SU_HAS_NEW_CXT
- XSH_D(su_debug_log("%p:     cx=%-2d %-11s\n",
-      ud, cur_cx_ix, SU_CXNAME(cxstack+cur_cx_ix)));
+ XSH_D(xsh_debug_log("%p:     cx=%-2d %-11s\n",
+                      ud,   cur_cx_ix, SU_CXNAME(cxstack+cur_cx_ix)));
  cur_cx_ix++;
 #endif
 
  for (i = 0; cur_scope_ix < PL_scopestack_ix; i++) {
   I32 *ixp;
-  I32 offset;
+  I32  offset;
 
 #if SU_HAS_NEW_CXT
 
-  if (   cur_cx_ix <= cxstack_ix
-      && cur_scope_ix == cxstack[cur_cx_ix].blk_oldscopesp
-  )
+  if (cur_cx_ix <= cxstack_ix
+      && cur_scope_ix == cxstack[cur_cx_ix].blk_oldscopesp)
    ixp = &(cxstack[cur_cx_ix++].blk_oldsaveix);
   else
    ixp = &PL_scopestack[cur_scope_ix++]; /* an ENTER pushed after cur context */
@@ -1253,23 +1278,23 @@ static void su_init(pTHX_ void *ud, I32 cxix, I32 size) {
   XSH_D({
    if (cur_cx_ix <= cxstack_ix) {
     if (cur_scope_ix == cxstack[cur_cx_ix].blk_oldscopesp) {
-     su_debug_log(
-       "%p:     cx=%-2d %s\n%p:     ------------------\n",
-       ud, cur_cx_ix, SU_CXNAME(cxstack+cur_cx_ix), ud);
+     xsh_debug_log("%p:     cx=%-2d %s\n%p:     ------------------\n",
+                    ud,   cur_cx_ix, SU_CXNAME(cxstack+cur_cx_ix), ud);
      cur_cx_ix++;
     }
     else if (cur_scope_ix + su_cxt_enter_count[CxTYPE(cxstack+cur_cx_ix)]
              == cxstack[cur_cx_ix].blk_oldscopesp)
-     su_debug_log("%p:     ------------------\n", ud);
+     xsh_debug_log("%p:     ------------------\n", ud);
    }
   });
+
   ixp = &PL_scopestack[cur_scope_ix++];
 
 #endif
 
-  if (i == 0)
+  if (i == 0) {
    offset = size;
-  else {
+  } else {
    /* we have three constraints to satisfy:
     * 1) Each adjusted offset must be at least SU_SAVE_DESTRUCTOR_SIZE
     *    above its unadjusted boundary, so that there is space to inject a
@@ -1285,7 +1310,8 @@ static void su_init(pTHX_ void *ud, I32 cxix, I32 size) {
     */
    I32 pad;
    offset = SU_SAVE_DESTRUCTOR_SIZE; /* rule 1 */
-   pad = (origin[i-1].orig_ix + origin[i-1].offset) + offset - (*ixp + offset);
+   pad    = (origin[i-1].orig_ix + origin[i-1].offset) + offset
+            - (*ixp + offset);
    if (pad > 0) { /* rule 2 */
     if (pad < SU_SAVE_ALLOC_SIZE + 1) /* rule 3 */
      pad = SU_SAVE_ALLOC_SIZE + 1;
@@ -1293,24 +1319,24 @@ static void su_init(pTHX_ void *ud, I32 cxix, I32 size) {
    }
   }
 
-  origin[i].offset = offset;
+  origin[i].offset  = offset;
   origin[i].orig_ix = *ixp;
-  *ixp += offset;
+  *ixp             += offset;
 
 #if SU_HAS_NEW_CXT
   XSH_D({
    if (ixp == &PL_scopestack[cur_scope_ix-1])
-    su_debug_log(
+    xsh_debug_log(
      "%p:           ENTER       origin[%d] scope[%d] savestack=%d+%d\n",
       ud, i, cur_scope_ix, origin[i].orig_ix, origin[i].offset);
    else
-    su_debug_log(
+    xsh_debug_log(
      "%p:     cx=%-2d %-11s origin[%d] scope[%d] savestack=%d+%d\n",
       ud, cur_cx_ix-1, SU_CXNAME(cxstack+cur_cx_ix-1),
       i, cur_scope_ix, origin[i].orig_ix, origin[i].offset);
   });
 #else
-  XSH_D(su_debug_log(
+  XSH_D(xsh_debug_log(
     "%p:                 ENTER origin[%d] scope[%d] savestack=%d+%d\n",
      ud, i, cur_scope_ix, origin[i].orig_ix, origin[i].offset));
 #endif
@@ -1322,7 +1348,7 @@ static void su_init(pTHX_ void *ud, I32 cxix, I32 size) {
  SU_UD_DEPTH(ud)  = depth;
  SU_UD_ORIGIN(ud) = origin;
 
- su_ss_push_destructor(aTHX_ ud, depth-1, 1);
+ su_ss_push_destructor(ud, depth-1, 1);
 }
 
 /* --- Unwind stack -------------------------------------------------------- */
@@ -1354,7 +1380,7 @@ static void su_unwind(pTHX_ void *ud_) {
 
  XSH_D({
   I32 gimme = GIMME_V;
-  su_debug_log("%p: cx=%d gimme=%s items=%d sp=%d oldmark=%d mark=%d\n",
+  xsh_debug_log("%p: cx=%d gimme=%s items=%d sp=%d oldmark=%d mark=%d\n",
                 &XSH_CXT, cxix,
                 gimme == G_VOID ? "void" : gimme == G_ARRAY ? "list" : "scalar",
                 items, PL_stack_sp - PL_stack_base, *PL_markstack_ptr, mark);
@@ -1392,8 +1418,6 @@ static void su_yield(pTHX_ void *ud_) {
  U8      flags = 0;
  OP     *next;
 
- PERL_UNUSED_VAR(ud_);
-
  cx = cxstack + cxix;
  switch (CxTYPE(cx)) {
   case CXt_BLOCK: {
@@ -1716,10 +1740,10 @@ static void su_uplevel_restore_new(pTHX_ void *sus_) {
 
  for (i = 0; i < sud->gap; i++) {
   PERL_CONTEXT *cx = cxstack + sud->cxix + i;
-   XSH_D(su_debug_log("su_uplevel_restore: i=%d cxix=%d type %s => %s\n",
-        i, cx-cxstack, SU_CX_TYPENAME(CxTYPE(cx)),
-        SU_CX_TYPENAME(saved_cxtypes[i] & CXTYPEMASK)));
-   cx->cx_type = saved_cxtypes[i];
+  XSH_D(xsh_debug_log("su_uplevel_restore: i=%d cxix=%d type %s => %s\n",
+                      i, cx-cxstack, SU_CX_TYPENAME(CxTYPE(cx)),
+                      SU_CX_TYPENAME(saved_cxtypes[i] & CXTYPEMASK)));
+  cx->cx_type = saved_cxtypes[i];
  }
  Safefree(saved_cxtypes);
 
@@ -1998,28 +2022,38 @@ static int su_uplevel_runops_hook_entersub(pTHX) {
   */
  assert(sud);
  if (sud->argarray) {
+  I32 fill;
   AV *av = newAV();
   AvREAL_off(av);
   AvREIFY_on(av);
-  av_extend(av, AvMAX(sud->argarray));
-  AvFILLp(av) = AvFILLp(sud->argarray);
-  Copy(AvARRAY(sud->argarray), AvARRAY(av), AvFILLp(av) + 1, SV *);
 
+  fill = AvFILLp(sud->argarray);
+  if (fill >= 0) {
+   av_extend(av, fill);
+   Copy(AvARRAY(sud->argarray), AvARRAY(av), fill + 1, SV *);
+   AvFILLp(av) = fill;
+  }
+
+#if !XSH_HAS_PERL(5, 37, 10)
   /* should be referenced by PL_curpad[0] and *_ */
   assert(SvREFCNT(PL_curpad[0]) > 1);
   SvREFCNT_dec(PL_curpad[0]);
+#endif
 
-  PL_curpad[0] = (SV*)av;
+  PL_curpad[0] = (SV *) av;
  }
 
  /* undo the temporary runops hook and fall through to a real runops loop. */
  assert(sud->old_runops != su_uplevel_runops_hook_entersub);
  PL_runops = sud->old_runops;
+
  CALLRUNOPS(aTHX);
+
  return 0;
 }
 
 static I32 su_uplevel_new(pTHX_ CV *callback, I32 cxix, I32 args) {
+#define su_uplevel_new(CB, CX, A) su_uplevel_new(aTHX_ (CB), (CX), (A))
  su_uplevel_ud *sud;
  U8 *saved_cxtypes;
  I32 i, ret;
@@ -2035,7 +2069,7 @@ static I32 su_uplevel_new(pTHX_ CV *callback, I32 cxix, I32 args) {
 
  /* At this point SP points to the top arg.
   * Shuffle the args down by one, eliminating the CV slot */
- Move(SP - args + 1, SP - args, args, SV*);
+ Move(SP - args + 1, SP - args, args, SV *);
  SP--;
  PUSHMARK(SP - args);
  PUTBACK;
@@ -2043,7 +2077,7 @@ static I32 su_uplevel_new(pTHX_ CV *callback, I32 cxix, I32 args) {
  sud = su_uplevel_storage_new(cxix);
 
  sud->cxix     = cxix;
- sud->callback = (CV*)SvREFCNT_inc_simple(callback);
+ sud->callback = (CV *) SvREFCNT_inc_simple(callback);
  sud->renamed  = NULL;
  sud->gap      = cxstack_ix - cxix + 1;
  sud->argarray = NULL;
@@ -2059,18 +2093,18 @@ static I32 su_uplevel_new(pTHX_ CV *callback, I32 cxix, I32 args) {
  for (i = 0; i < sud->gap; i++) {
   PERL_CONTEXT *cx = cxstack + cxix + i;
   saved_cxtypes[i] = cx->cx_type; /* save type and flags */
-  XSH_D(su_debug_log("su_uplevel: i=%d cxix=%d type %-11s => %s\n",
+  XSH_D(xsh_debug_log("su_uplevel: i=%d cxix=%d type %-11s => %s\n",
         i, cx-cxstack, SU_CX_TYPENAME(CxTYPE(cx)), SU_CX_TYPENAME(CXt_NULL)));
   cx->cx_type = (CXt_NULL | CXp_SU_UPLEVEL_NULLED);
  }
 
  /* create a copy of the callback with a doctored name (as seen by
   * caller). It shares the padlist with callback */
- sud->renamed = su_cv_clone(callback, CvGV(base_cv));
+ sud->renamed    = su_cv_clone(callback, CvGV(base_cv));
  sud->old_runops = PL_runops;
 
  if (!CvISXSUB(sud->renamed) && CxHASARGS(&cxstack[cxix])) {
-  sud->argarray = (AV*)su_at_underscore(base_cv);
+  sud->argarray = (AV *) su_at_underscore(base_cv);
   assert(PL_runops != su_uplevel_runops_hook_entersub);
   /* set up a one-shot runops hook so that we can fake up the
    * args as seen by caller() on return from pp_entersub */
@@ -2079,7 +2113,7 @@ static I32 su_uplevel_new(pTHX_ CV *callback, I32 cxix, I32 args) {
 
  CvDEPTH(callback)++; /* match what CvDEPTH(sud->renamed) is about to become */
 
- ret = call_sv((SV*)sud->renamed, gimme);
+ ret = call_sv((SV *) sud->renamed, gimme);
 
  LEAVE;
 
@@ -2089,6 +2123,7 @@ static I32 su_uplevel_new(pTHX_ CV *callback, I32 cxix, I32 args) {
 #else
 
 static I32 su_uplevel_old(pTHX_ CV *callback, I32 cxix, I32 args) {
+#define su_uplevel_old(CB, CX, A) su_uplevel_old(aTHX_ (CB), (CX), (A))
  su_uplevel_ud *sud;
  const PERL_CONTEXT *cx = cxstack + cxix;
  PERL_SI *si;
@@ -2453,7 +2488,9 @@ static I32 su_context_real2logical(pTHX_ I32 cxix) {
   if (cx->cx_type == (CXt_NULL | CXp_SU_UPLEVEL_NULLED))
    gaps++;
  }
- XSH_D(su_debug_log("su_context_real2logical: %d => %d\n", cxix, cxix - gaps));
+
+ XSH_D(xsh_debug_log("su_context_real2logical: %d => %d\n", cxix, cxix - gaps));
+
  return cxix - gaps;
 }
 
@@ -2473,9 +2510,12 @@ static I32 su_context_logical2real(pTHX_ I32 cxix) {
   if (seen >= cxix)
    break;
  }
- XSH_D(su_debug_log("su_context_logical2real: %d => %d\n", cxix, i));
+
+ XSH_D(xsh_debug_log("su_context_logical2real: %d => %d\n", cxix, i));
+
  if (i > cxstack_ix)
   i = cxstack_ix;
+
  return i;
 }
 
@@ -2814,7 +2854,9 @@ XS(XS_Scope__Upper_leave) {
  /* See XS_Scope__Upper_unwind */
  if (GIMME_V == G_SCALAR)
   PL_stack_sp = PL_stack_base + PL_markstack_ptr[1] + 1;
+
  SAVEDESTRUCTOR_X(su_yield, su_leave_name);
+
  return;
 }
 
@@ -3096,7 +3138,9 @@ PPCODE:
  /* warnings (9) */
  {
   SV *mask = NULL;
-#if XSH_HAS_PERL(5, 9, 4)
+#if XSH_HAS_PERL(5, 37, 6)
+  char *old_warnings = cop->cop_warnings;
+#elif XSH_HAS_PERL(5, 9, 4)
   STRLEN *old_warnings = cop->cop_warnings;
 #else
   SV *old_warnings = cop->cop_warnings;
@@ -3129,7 +3173,9 @@ context_info_warnings_on:
    if (!mask)
     mask = su_newmortal_pvn(WARN_ALLstring, WARNsize);
   } else {
-#if XSH_HAS_PERL(5, 9, 4)
+#if XSH_HAS_PERL(5, 37, 6)
+   mask = su_newmortal_pvn((char *) old_warnings, RCPV_LEN(old_warnings));
+#elif XSH_HAS_PERL(5, 9, 4)
    mask = su_newmortal_pvn((char *) (old_warnings + 1), old_warnings[0]);
 #else
    mask = sv_mortalcopy(old_warnings);
@@ -3247,9 +3293,9 @@ PPCODE:
     }
     /* su_uplevel() takes care of extending the stack if needed. */
 #if SU_HAS_NEW_CXT
-    ret = su_uplevel_new(aTHX_ (CV *) code, cxix, args);
+    ret = su_uplevel_new((CV *) code, cxix, args);
 #else
-    ret = su_uplevel_old(aTHX_ (CV *) code, cxix, args);
+    ret = su_uplevel_old((CV *) code, cxix, args);
 #endif
     XSRETURN(ret);
    default: