+#define IS_NUMBER_IN_UV 0x1
+
+static int su_grok_number(pTHX_ const char *s, STRLEN len, UV *valuep) {
+#define su_grok_number(S, L, VP) su_grok_number(aTHX_ (S), (L), (VP))
+ STRLEN i;
+ SV *tmpsv;
+
+ /* This crude check should be good enough for a fallback implementation.
+ * Better be too strict than too lax. */
+ for (i = 0; i < len; ++i) {
+ if (!isDIGIT(s[i]))
+ return 0;
+ }
+
+ tmpsv = sv_newmortal();
+ sv_setpvn(tmpsv, s, len);
+ *valuep = sv_2uv(tmpsv);
+
+ return IS_NUMBER_IN_UV;
+}
+
+#endif /* !grok_number */
+
+static int su_uid_validate(pTHX_ SV *uid) {
+#define su_uid_validate(U) su_uid_validate(aTHX_ (U))
+ const char *s;
+ STRLEN len, p = 0;
+ UV depth, seq;
+ int type;
+
+ s = SvPV_const(uid, len);
+
+ while (p < len && s[p] != '-')
+ ++p;
+ if (p >= len)
+ croak("UID contains only one part");
+
+ type = su_grok_number(s, p, &depth);
+ if (type != IS_NUMBER_IN_UV)
+ croak("First UID part is not an unsigned integer");
+
+ ++p; /* Skip '-'. As we used to have p < len, len - (p + 1) >= 0. */
+
+ type = su_grok_number(s + p, len - p, &seq);
+ if (type != IS_NUMBER_IN_UV)
+ croak("Second UID part is not an unsigned integer");
+
+ return su_uid_storage_check(depth, seq);
+}
+
+/* --- Context operations -------------------------------------------------- */
+
+/* Remove sequences of BLOCKs having DB for stash, followed by a SUB context
+ * for the debugger callback. */
+
+static I32 su_context_skip_db(pTHX_ I32 cxix) {
+#define su_context_skip_db(C) su_context_skip_db(aTHX_ (C))
+ I32 i;
+
+ if (!PL_DBsub)
+ return cxix;
+
+ for (i = cxix; i > 0; --i) {
+ PERL_CONTEXT *cx = cxstack + i;
+
+ switch (CxTYPE(cx)) {
+#if XSH_HAS_PERL(5, 17, 1)
+ case CXt_LOOP_PLAIN:
+#endif
+ case CXt_BLOCK:
+ if (cx->blk_oldcop && CopSTASH(cx->blk_oldcop) == GvSTASH(PL_DBgv))
+ continue;
+ break;
+ case CXt_SUB:
+ if (cx->blk_sub.cv == GvCV(PL_DBsub)) {
+ cxix = i - 1;
+ continue;
+ }
+ break;
+ default:
+ break;
+ }
+
+ break;
+ }
+
+ return cxix;
+}
+
+#if SU_HAS_NEW_CXT
+
+/* convert a physical context stack index into the logical equivalent:
+ * one that ignores all the context frames hidden by uplevel().
+ * Perl-level functions use logical args (e.g. UP takes an optional logical
+ * value and returns a logical value), while we use and store *real*
+ * values internally.
+ */
+
+static I32 su_context_real2logical(pTHX_ I32 cxix) {
+# define su_context_real2logical(C) su_context_real2logical(aTHX_ (C))
+ PERL_CONTEXT *cx;
+ I32 i, gaps = 0;
+
+ for (i = 0; i <= cxix; i++) {
+ cx = cxstack + i;
+ 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));
+ return cxix - gaps;
+}
+
+/* convert a logical context stack index (one that ignores all the context
+ * frames hidden by uplevel) into the physical equivalent
+ */
+
+static I32 su_context_logical2real(pTHX_ I32 cxix) {
+# define su_context_logical2real(C) su_context_logical2real(aTHX_ (C))
+ PERL_CONTEXT *cx;
+ I32 i, seen = -1;
+
+ for (i = 0; i <= cxstack_ix; i++) {
+ PERL_CONTEXT *cx = cxstack + i;
+ if (cx->cx_type != (CXt_NULL | CXp_SU_UPLEVEL_NULLED))
+ seen++;
+ if (seen >= cxix)
+ break;
+ }
+ XSH_D(su_debug_log("su_context_logical2real: %d => %d\n", cxix, i));
+ if (i > cxstack_ix)
+ i = cxstack_ix;
+ return i;
+}
+
+#else
+# define su_context_real2logical(C) (C)
+# define su_context_logical2real(C) (C)
+#endif
+
+static I32 su_context_normalize_up(pTHX_ I32 cxix) {
+#define su_context_normalize_up(C) su_context_normalize_up(aTHX_ (C))
+ PERL_CONTEXT *cx;
+
+ if (cxix <= 0)
+ return 0;
+
+ cx = cxstack + cxix;
+ if (CxTYPE(cx) == CXt_BLOCK) {
+ PERL_CONTEXT *prev = cx - 1;
+
+ switch (CxTYPE(prev)) {
+#if XSH_HAS_PERL(5, 10, 0)
+ case CXt_GIVEN:
+ case CXt_WHEN:
+#endif
+#if XSH_HAS_PERL(5, 11, 0)
+ /* That's the only subcategory that can cause an extra BLOCK context */
+ case CXt_LOOP_PLAIN:
+#else
+ case CXt_LOOP:
+#endif
+ if (cx->blk_oldcop == prev->blk_oldcop)
+ return cxix - 1;
+ break;
+ case CXt_SUBST:
+ if (cx->blk_oldcop && OpSIBLING(cx->blk_oldcop)
+ && OpSIBLING(cx->blk_oldcop)->op_type == OP_SUBST)
+ return cxix - 1;
+ break;
+ }
+ }
+
+ return cxix;
+}
+
+static I32 su_context_normalize_down(pTHX_ I32 cxix) {
+#define su_context_normalize_down(C) su_context_normalize_down(aTHX_ (C))
+ PERL_CONTEXT *next;
+
+ if (cxix >= cxstack_ix)
+ return cxstack_ix;
+
+ next = cxstack + cxix + 1;
+ if (CxTYPE(next) == CXt_BLOCK) {
+ PERL_CONTEXT *cx = next - 1;
+
+ switch (CxTYPE(cx)) {
+#if XSH_HAS_PERL(5, 10, 0)
+ case CXt_GIVEN:
+ case CXt_WHEN:
+#endif
+#if XSH_HAS_PERL(5, 11, 0)
+ /* That's the only subcategory that can cause an extra BLOCK context */
+ case CXt_LOOP_PLAIN:
+#else
+ case CXt_LOOP:
+#endif
+ if (cx->blk_oldcop == next->blk_oldcop)
+ return cxix + 1;
+ break;
+ case CXt_SUBST:
+ if (next->blk_oldcop && OpSIBLING(next->blk_oldcop)
+ && OpSIBLING(next->blk_oldcop)->op_type == OP_SUBST)
+ return cxix + 1;
+ break;
+ }
+ }
+
+ return cxix;
+}
+
+#define su_context_here() su_context_normalize_up(su_context_skip_db(cxstack_ix))
+
+static I32 su_context_gimme(pTHX_ I32 cxix) {
+#define su_context_gimme(C) su_context_gimme(aTHX_ (C))
+ I32 i;
+
+ for (i = cxix; i >= 0; --i) {
+ PERL_CONTEXT *cx = cxstack + i;
+
+ switch (CxTYPE(cx)) {
+ /* gimme is always G_ARRAY for loop contexts. */
+#if XSH_HAS_PERL(5, 11, 0)
+# if XSH_HAS_PERL(5, 23, 8)
+ case CXt_LOOP_ARY:
+ case CXt_LOOP_LIST:
+# else
+ case CXt_LOOP_FOR:
+# endif
+ case CXt_LOOP_PLAIN:
+ case CXt_LOOP_LAZYSV:
+ case CXt_LOOP_LAZYIV:
+#else
+ case CXt_LOOP:
+#endif
+ case CXt_SUBST: {
+ const COP *cop = cx->blk_oldcop;
+ if (cop && OpSIBLING(cop)) {
+ switch (OpSIBLING(cop)->op_flags & OPf_WANT) {
+ case OPf_WANT_VOID:
+ return G_VOID;
+ case OPf_WANT_SCALAR:
+ return G_SCALAR;
+ case OPf_WANT_LIST:
+ return G_ARRAY;
+ default:
+ break;
+ }
+ }
+ break;
+ }
+ default:
+ return CxGIMME(cx);
+ break;
+ }
+ }
+
+ return G_VOID;
+}
+
+/* --- Module setup/teardown ----------------------------------------------- */
+
+static void xsh_user_global_setup(pTHX) {
+ HV *stash;
+
+ MUTEX_INIT(&su_uid_seq_counter_mutex);
+
+ XSH_LOCK(&su_uid_seq_counter_mutex);
+ su_uid_seq_counter.seqs = NULL;
+ su_uid_seq_counter.size = 0;
+ XSH_UNLOCK(&su_uid_seq_counter_mutex);
+
+ stash = gv_stashpv(XSH_PACKAGE, 1);
+ newCONSTSUB(stash, "TOP", newSViv(0));
+ newCONSTSUB(stash, "SU_THREADSAFE", newSVuv(XSH_THREADSAFE));
+
+ return;
+}
+
+static void xsh_user_local_setup(pTHX_ xsh_user_cxt_t *cxt) {
+
+ /* NewOp() calls calloc() which just zeroes the memory with memset(). */
+ Zero(&(cxt->unwind_storage.return_op), 1, LISTOP);
+ cxt->unwind_storage.return_op.op_type = OP_RETURN;
+ cxt->unwind_storage.return_op.op_ppaddr = PL_ppaddr[OP_RETURN];
+
+ Zero(&(cxt->unwind_storage.proxy_op), 1, OP);
+ cxt->unwind_storage.proxy_op.op_type = OP_STUB;
+ cxt->unwind_storage.proxy_op.op_ppaddr = NULL;
+
+ Zero(&(cxt->yield_storage.leave_op), 1, UNOP);
+ cxt->yield_storage.leave_op.op_type = OP_STUB;
+ cxt->yield_storage.leave_op.op_ppaddr = NULL;
+
+ Zero(&(cxt->yield_storage.proxy_op), 1, OP);
+ cxt->yield_storage.proxy_op.op_type = OP_STUB;
+ cxt->yield_storage.proxy_op.op_ppaddr = NULL;
+
+ cxt->uplevel_storage.top = NULL;
+ cxt->uplevel_storage.root = NULL;
+ cxt->uplevel_storage.count = 0;
+
+ cxt->uid_storage.map = NULL;
+ cxt->uid_storage.used = 0;
+ cxt->uid_storage.alloc = 0;
+
+ return;
+}
+
+static void xsh_user_local_teardown(pTHX_ xsh_user_cxt_t *cxt) {