+ }
+ else if (SvPOK(ERRSV) && SvCUR(ERRSV)) {
+ exsv = sv_mortalcopy(ERRSV);
+ sv_catpvs(exsv, "\t...propagated");
+ }
+ else {
+ exsv = newSVpvs_flags("Died", SVs_TEMP);
+ }
+ return die_sv(exsv);
+}
+
+/* I/O. */
+
+OP *
+Perl_tied_method(pTHX_ const char *const methname, SV **sp, SV *const sv,
+ const MAGIC *const mg, const U32 flags, U32 argc, ...)
+{
+ SV **orig_sp = sp;
+ I32 ret_args;
+
+ PERL_ARGS_ASSERT_TIED_METHOD;
+
+ /* Ensure that our flag bits do not overlap. */
+ assert((TIED_METHOD_MORTALIZE_NOT_NEEDED & G_WANT) == 0);
+ assert((TIED_METHOD_ARGUMENTS_ON_STACK & G_WANT) == 0);
+ assert((TIED_METHOD_SAY & G_WANT) == 0);
+
+ PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
+ PUSHSTACKi(PERLSI_MAGIC);
+ EXTEND(SP, argc+1); /* object + args */
+ PUSHMARK(sp);
+ PUSHs(SvTIED_obj(sv, mg));
+ if (flags & TIED_METHOD_ARGUMENTS_ON_STACK) {
+ Copy(orig_sp + 2, sp + 1, argc, SV*); /* copy args to new stack */
+ sp += argc;
+ }
+ else if (argc) {
+ const U32 mortalize_not_needed
+ = flags & TIED_METHOD_MORTALIZE_NOT_NEEDED;
+ va_list args;
+ va_start(args, argc);
+ do {
+ SV *const arg = va_arg(args, SV *);
+ if(mortalize_not_needed)
+ PUSHs(arg);