PERL_ARGS_ASSERT_SAVE_MAGIC;
+ /* guard against sv having being freed midway by holding a private
+ reference. */
+ SvREFCNT_inc_simple_void_NN(sv);
+
assert(SvMAGICAL(sv));
/* Turning READONLY off for a copy-on-write scalar (including shared
hash keys) is a bad idea. */
{
dVAR;
const I32 mgs_ix = SSNEW(sizeof(MGS));
- const bool was_temp = cBOOL(SvTEMP(sv));
bool have_new = 0;
MAGIC *newmg, *head, *cur, *mg;
- /* guard against sv having being freed midway by holding a private
- reference. */
PERL_ARGS_ASSERT_MG_GET;
- /* sv_2mortal has this side effect of turning on the TEMP flag, which can
- cause the SV's buffer to get stolen (and maybe other stuff).
- So restore it.
- */
- sv_2mortal(SvREFCNT_inc_simple_NN(sv));
- if (!was_temp) {
- SvTEMP_off(sv);
- }
-
save_magic(mgs_ix, sv);
/* We must call svt_get(sv, mg) for each valid entry in the linked
}
restore_magic(INT2PTR(void *, (IV)mgs_ix));
-
- if (SvREFCNT(sv) == 1) {
- /* We hold the last reference to this SV, which implies that the
- SV was deleted as a side effect of the routines we called. */
- SvOK_off(sv);
- }
return 0;
}
mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
(SSPTR(mgs_ix, MGS*))->mgs_magical = 0;
}
- if (PL_localizing == 2 && !S_is_container_magic(mg))
+ if (PL_localizing == 2 && (!S_is_container_magic(mg) || sv == DEFSV))
continue;
if (vtbl && vtbl->svt_set)
vtbl->svt_set(aTHX_ sv, mg);
PERL_ARGS_ASSERT_MG_LOCALIZE;
+ if (nsv == DEFSV)
+ return;
+
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
const MGVTBL* const vtbl = mg->mg_virtual;
if (!S_is_container_magic(mg))
#ifdef VMS
if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) {
char pathbuf[256], eltbuf[256], *cp, *elt;
- Stat_t sbuf;
int i = 0, j = 0;
my_strlcpy(eltbuf, s, sizeof(eltbuf));
}
#endif
+#if defined HAS_SIGPROCMASK
+static void
+unblock_sigmask(pTHX_ void* newset)
+{
+ sigprocmask(SIG_UNBLOCK, (sigset_t*)newset, NULL);
+}
+#endif
+
void
Perl_despatch_signals(pTHX)
{
for (sig = 1; sig < SIG_SIZE; sig++) {
if (PL_psig_pend[sig]) {
dSAVE_ERRNO;
- PERL_BLOCKSIG_ADD(set, sig);
+#ifdef HAS_SIGPROCMASK
+ /* From sigaction(2) (FreeBSD man page):
+ * | Signal routines normally execute with the signal that
+ * | caused their invocation blocked, but other signals may
+ * | yet occur.
+ * Emulation of this behavior (from within Perl) is enabled
+ * using sigprocmask
+ */
+ int was_blocked;
+ sigset_t newset, oldset;
+
+ sigemptyset(&newset);
+ sigaddset(&newset, sig);
+ sigprocmask(SIG_BLOCK, &newset, &oldset);
+ was_blocked = sigismember(&oldset, sig);
+ if (!was_blocked) {
+ SV* save_sv = newSVpvn((char *)(&newset), sizeof(sigset_t));
+ ENTER;
+ SAVEFREESV(save_sv);
+ SAVEDESTRUCTOR_X(unblock_sigmask, SvPV_nolen(save_sv));
+ }
+#endif
PL_psig_pend[sig] = 0;
- PERL_BLOCKSIG_BLOCK(set);
#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
(*PL_sighandlerp)(sig, NULL, NULL);
#else
(*PL_sighandlerp)(sig);
#endif
- PERL_BLOCKSIG_UNBLOCK(set);
+#ifdef HAS_SIGPROCMASK
+ if (!was_blocked)
+ LEAVE;
+#endif
RESTORE_ERRNO;
}
}
Invoke a magic method (like FETCH).
-* sv and mg are the tied thinggy and the tie magic;
+* sv and mg are the tied thingy and the tie magic;
* meth is the name of the method to call;
* 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.
PERL_ARGS_ASSERT_MAGIC_METHCALL;
ENTER;
+
+ if (flags & G_WRITING_TO_STDERR) {
+ SAVETMPS;
+
+ save_re_context();
+ SAVESPTR(PL_stderrgv);
+ PL_stderrgv = NULL;
+ }
+
PUSHSTACKi(PERLSI_MAGIC);
PUSHMARK(SP);
ret = *PL_stack_sp--;
}
POPSTACK;
+ if (flags & G_WRITING_TO_STDERR)
+ FREETMPS;
LEAVE;
return ret;
}
Signal_t
#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
-Perl_sighandler(int sig, siginfo_t *sip, void *uap PERL_UNUSED_DECL)
+Perl_sighandler(int sig, siginfo_t *sip, void *uap)
#else
Perl_sighandler(int sig)
#endif
exit(sig);
}
- /* Max number of items pushed there is 3*n or 4. We cannot fix
- infinity, so we fix 4 (in fact 5): */
- if (PL_savestack_ix + 15 <= PL_savestack_max) {
- flags |= 1;
- PL_savestack_ix += 5; /* Protect save in progress. */
- SAVEDESTRUCTOR_X(S_unwind_handler_stack, NULL);
- }
- if (PL_markstack_ptr < PL_markstack_max - 2) {
- flags |= 2;
- PL_markstack_ptr++; /* Protect mark. */
- }
- if (PL_scopestack_ix < PL_scopestack_max - 3) {
- flags |= 4;
- PL_scopestack_ix++;
+ if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) {
+ /* Max number of items pushed there is 3*n or 4. We cannot fix
+ infinity, so we fix 4 (in fact 5): */
+ if (PL_savestack_ix + 15 <= PL_savestack_max) {
+ flags |= 1;
+ PL_savestack_ix += 5; /* Protect save in progress. */
+ SAVEDESTRUCTOR_X(S_unwind_handler_stack, NULL);
+ }
}
/* sv_2cv is too complicated, try a simpler variant first: */
if (!SvROK(PL_psig_ptr[sig]) || !(cv = MUTABLE_CV(SvRV(PL_psig_ptr[sig])))
flags |= 8;
SAVEFREESV(sv);
- /* make sure our assumption about the size of the SAVEs are correct:
- * 3 for SAVEDESTRUCTOR_X, 2 for SAVEFREESV */
- assert(old_ss_ix + 2 + ((flags & 1) ? 3+5 : 0) == PL_savestack_ix);
+ if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) {
+ /* make sure our assumption about the size of the SAVEs are correct:
+ * 3 for SAVEDESTRUCTOR_X, 2 for SAVEFREESV */
+ assert(old_ss_ix + 2 + ((flags & 1) ? 3+5 : 0) == PL_savestack_ix);
+ }
PUSHSTACKi(PERLSI_SIGNAL);
PUSHMARK(SP);
POPSTACK;
if (SvTRUE(ERRSV)) {
#ifndef PERL_MICRO
-#ifdef HAS_SIGPROCMASK
/* Handler "died", for example to get out of a restart-able read().
* Before we re-do that on its behalf re-enable the signal which was
* blocked by the system when we entered.
*/
- sigset_t set;
- sigemptyset(&set);
- sigaddset(&set,sig);
- sigprocmask(SIG_UNBLOCK, &set, NULL);
+#ifdef HAS_SIGPROCMASK
+#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
+ if (sip || uap)
+#endif
+ {
+ sigset_t set;
+ sigemptyset(&set);
+ sigaddset(&set,sig);
+ sigprocmask(SIG_UNBLOCK, &set, NULL);
+ }
#else
/* Not clear if this will work */
(void)rsignal(sig, SIG_IGN);
cleanup:
/* pop any of SAVEFREESV, SAVEDESTRUCTOR_X and "save in progress" */
PL_savestack_ix = old_ss_ix;
- if (flags & 2)
- PL_markstack_ptr--;
- if (flags & 4)
- PL_scopestack_ix -= 1;
if (flags & 8)
SvREFCNT_dec(sv);
PL_op = myop; /* Apparently not needed... */
assert((popval & SAVE_MASK) == SAVEt_ALLOC);
PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT;
}
-
+ if (SvREFCNT(sv) == 1) {
+ /* We hold the last reference to this SV, which implies that the
+ SV was deleted as a side effect of the routines we called.
+ So artificially keep it alive a bit longer.
+ We avoid turning on the TEMP flag, which can cause the SV's
+ buffer to get stolen (and maybe other stuff). */
+ int was_temp = SvTEMP(sv);
+ sv_2mortal(sv);
+ if (!was_temp) {
+ SvTEMP_off(sv);
+ }
+ SvOK_off(sv);
+ }
+ else
+ SvREFCNT_dec(sv); /* undo the inc in S_save_magic() */
}
/* clean up the mess created by Perl_sighandler().
* Note that this is only called during an exit in a signal handler;
* a die is trapped by the call_sv() and the SAVEDESTRUCTOR_X manually
- * skipped over. This is why we don't need to fix up the markstack and
- * scopestack - they're going to be set to 0 anyway */
+ * skipped over. */
static void
S_unwind_handler_stack(pTHX_ const void *p)
https://perl5.git.perl.org / perl5.git / blobdiff