case PERL_MAGIC_arylen_p:
case PERL_MAGIC_rhash:
case PERL_MAGIC_symtab:
+ case PERL_MAGIC_tied: /* treat as value, so 'local @tied' isn't tied */
return 0;
default:
return 1;
PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET;
PERL_UNUSED_ARG(sv);
PERL_UNUSED_ARG(mg);
- Perl_croak(aTHX_ "%s", PL_no_modify);
+ Perl_croak_no_modify(aTHX);
NORETURN_FUNCTION_END;
}
PL_sig_pending = 0;
for (sig = 1; sig < SIG_SIZE; sig++) {
if (PL_psig_pend[sig]) {
+ dSAVE_ERRNO;
PERL_BLOCKSIG_ADD(set, sig);
PL_psig_pend[sig] = 0;
PERL_BLOCKSIG_BLOCK(set);
(*PL_sighandlerp)(sig);
#endif
PERL_BLOCKSIG_UNBLOCK(set);
+ RESTORE_ERRNO;
}
}
}
PERL_UNUSED_ARG(sv);
/* Skip _isaelem because _isa will handle it shortly */
- if (PL_delaymagic & DM_ARRAY && mg->mg_type == PERL_MAGIC_isaelem)
+ if (PL_delaymagic & DM_ARRAY_ISA && mg->mg_type == PERL_MAGIC_isaelem)
return 0;
return magic_clearisa(NULL, mg);
* sv and mg are the tied thinggy and the tie magic;
* meth is the name of the method to call;
-* n, arg1, arg2 are the number of args (in addition to $self) to pass to
- the method, and the args themselves (negative n is special-cased);
+* argc is the number of args (in addition to $self) to pass to the method;
+ the args themselves are any values following the argc argument.
* flags:
G_DISCARD: invoke method with G_DISCARD flag and don't return a value
+ G_UNDEF_FILL: fill the stack with argc pointers to PL_sv_undef.
Returns the SV (if any) returned by the method, or NULL on failure.
*/
SV*
-Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
- int n, SV *arg1, SV *arg2)
+Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
+ U32 argc, ...)
{
dVAR;
dSP;
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
- if (n < 0) {
- /* special case for UNSHIFT */
- EXTEND(SP,-n+1);
- PUSHs(SvTIED_obj(sv, mg));
- while (n++ < 0) {
+ EXTEND(SP, argc+1);
+ PUSHs(SvTIED_obj(sv, mg));
+ if (flags & G_UNDEF_FILL) {
+ while (argc--) {
PUSHs(&PL_sv_undef);
}
- }
- else {
- EXTEND(SP,n+1);
- PUSHs(SvTIED_obj(sv, mg));
- if (n > 0) {
- PUSHs(arg1);
- if (n > 1) PUSHs(arg2);
- assert(n <= 2);
- }
+ } else if (argc > 0) {
+ va_list args;
+ va_start(args, argc);
+
+ do {
+ SV *const sv = va_arg(args, SV *);
+ PUSHs(sv);
+ } while (--argc);
+
+ va_end(args);
}
PUTBACK;
if (flags & G_DISCARD) {
/* wrapper for magic_methcall that creates the first arg */
STATIC SV*
-S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags,
+S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
int n, SV *val)
{
dVAR;
sv_2mortal(arg1);
}
if (!arg1) {
- arg1 = val;
- n--;
+ return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n - 1, val);
}
- return magic_methcall(sv, mg, meth, flags, n, arg1, val);
+ return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n, arg1, val);
}
STATIC int
PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
- magic_methcall(sv, mg, "CLEAR", G_DISCARD, 0, NULL, NULL);
+ Perl_magic_methcall(aTHX_ sv, mg, "CLEAR", G_DISCARD, 0);
return 0;
}
PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
- ret = magic_methcall(sv, mg,
- (SvOK(key) ? "NEXTKEY" : "FIRSTKEY"),
- 0,
- (SvOK(key) ? 1 : 0), key, NULL);
+ ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, "NEXTKEY", 0, 1, key)
+ : Perl_magic_methcall(aTHX_ sv, mg, "FIRSTKEY", 0, 0);
if (ret)
sv_setsv(key,ret);
return 0;
}
/* there is a SCALAR method that we can call */
- retval = magic_methcall(MUTABLE_SV(hv), mg, "SCALAR", 0, 0, NULL, NULL);
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, "SCALAR", 0, 0);
if (!retval)
retval = &PL_sv_undef;
return retval;
Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
{
PERL_ARGS_ASSERT_MAGIC_KILLBACKREFS;
- return Perl_sv_kill_backrefs(aTHX_ sv, MUTABLE_AV(mg->mg_obj));
+ Perl_sv_kill_backrefs(aTHX_ sv, MUTABLE_AV(mg->mg_obj));
+ return 0;
}
int
* set without a previous pattern match. Unless it's C<local $1>
*/
if (!PL_localizing) {
- Perl_croak(aTHX_ "%s", PL_no_modify);
+ Perl_croak_no_modify(aTHX);
}
}
case '\001': /* ^A */
(void)rsignal(sig, PL_csighandlerp);
#endif
#endif /* !PERL_MICRO */
- Perl_die(aTHX_ NULL);
+ die_sv(ERRSV);
}
cleanup:
if (flags & 1)
*/
if (PL_savestack_ix == mgs->mgs_ss_ix)
{
- I32 popval = SSPOPINT;
+ UV popval = SSPOPUV;
assert(popval == SAVEt_DESTRUCTOR_X);
PL_savestack_ix -= 2;
- popval = SSPOPINT;
- assert(popval == SAVEt_ALLOC);
- popval = SSPOPINT;
- PL_savestack_ix -= popval;
+ popval = SSPOPUV;
+ assert((popval & SAVE_MASK) == SAVEt_ALLOC);
+ PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT;
}
}