* come here, and I don't want to see no more magic,' he said, and fell silent."
*/
+/*
+=head1 Magical Functions
+*/
+
#include "EXTERN.h"
#define PERL_IN_MG_C
#include "perl.h"
#if !defined(HAS_SIGACTION) && defined(VMS)
# define FAKE_PERSISTENT_SIGNAL_HANDLERS
#endif
+/* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */
+#if defined(KILL_BY_SIGPRC)
+# define FAKE_DEFAULT_SIGNAL_HANDLERS
+#endif
static void restore_magic(pTHX_ void *p);
static void unwind_handler_stack(pTHX_ void *p);
int count = 0;
MAGIC* mg;
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
- if (isUPPER(mg->mg_type)) {
+ MGVTBL* vtbl = mg->mg_virtual;
+ if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
+ count += CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv, key, klen);
+ }
+ else if (isUPPER(mg->mg_type)) {
sv_magic(nsv,
mg->mg_type == PERL_MAGIC_tied ? SvTIED_obj(sv, mg) :
(mg->mg_type == PERL_MAGIC_regdata && mg->mg_obj)
Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i);
return i;
}
+ else {
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit();
+ }
+ }
+ else {
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit();
}
return 0;
case '+':
register char *s;
char *ptr;
STRLEN len, klen;
- I32 i;
s = SvPV(sv,len);
ptr = MgPV(mg,klen);
while (s < strend) {
char tmpbuf[256];
struct stat st;
+ I32 i;
s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
s, strend, ':', &i);
s++;
return 0;
}
+#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS)||defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
+static int sig_handlers_initted = 0;
+#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-static int sig_ignoring_initted = 0;
static int sig_ignoring[SIG_SIZE]; /* which signals we are ignoring */
#endif
+#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
+static int sig_defaulting[SIG_SIZE];
+#endif
#ifndef PERL_MICRO
int
sv_setsv(sv,PL_psig_ptr[i]);
else {
Sighandler_t sigstate;
+ sigstate = rsignal_state(i);
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
- if (sig_ignoring_initted && sig_ignoring[i])
- sigstate = SIG_IGN;
- else
+ if (sig_handlers_initted && sig_ignoring[i]) sigstate = SIG_IGN;
+#endif
+#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
+ if (sig_handlers_initted && sig_defaulting[i]) sigstate = SIG_DFL;
#endif
- sigstate = rsignal_state(i);
-
/* cache state so we don't fetch it again */
if(sigstate == SIG_IGN)
sv_setpv(sv,"IGNORE");
Signal_t
Perl_csighandler(int sig)
{
-#ifndef PERL_OLD_SIGNALS
+#ifdef PERL_GET_SIG_CONTEXT
+ dTHXa(PERL_GET_SIG_CONTEXT);
+#else
dTHX;
#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
(void) rsignal(sig, &Perl_csighandler);
if (sig_ignoring[sig]) return;
#endif
+#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
+ if (sig_defaulting[sig])
+#ifdef KILL_BY_SIGPRC
+ exit((Perl_sig_to_vmscondition(sig)&STS$M_COND_ID)|STS$K_SEVERE|STS$M_INHIB_MSG);
+#else
+ exit(1);
+#endif
+#endif
+
#ifdef PERL_OLD_SIGNALS
/* Call the perl level handler now with risk we may be in malloc() etc. */
(*PL_sighandlerp)(sig);
#endif
}
+#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
+void
+Perl_csighandler_init(void)
+{
+ int sig;
+ if (sig_handlers_initted) return;
+
+ for (sig = 1; sig < SIG_SIZE; sig++) {
+#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
+ dTHX;
+ sig_defaulting[sig] = 1;
+ (void) rsignal(sig, &Perl_csighandler);
+#endif
+#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
+ sig_ignoring[sig] = 0;
+#endif
+ }
+ sig_handlers_initted = 1;
+}
+#endif
+
void
Perl_despatch_signals(pTHX)
{
Perl_warner(aTHX_ WARN_SIGNAL, "No such signal: SIG%s", s);
return 0;
}
+#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
+ if (!sig_handlers_initted) Perl_csighandler_init();
+#endif
#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
- if (!sig_ignoring_initted) {
- int j;
- for (j = 0; j < SIG_SIZE; j++) sig_ignoring[j] = 0;
- sig_ignoring_initted = 1;
- }
sig_ignoring[i] = 0;
#endif
+#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
+ sig_defaulting[i] = 0;
+#endif
SvREFCNT_dec(PL_psig_name[i]);
SvREFCNT_dec(PL_psig_ptr[i]);
PL_psig_ptr[i] = SvREFCNT_inc(sv);
}
else if (strEQ(s,"DEFAULT") || !*s) {
if (i)
+#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
+ {
+ sig_defaulting[i] = 1;
+ (void)rsignal(i, &Perl_csighandler);
+ }
+#else
(void)rsignal(i, SIG_DFL);
+#endif
else
*svp = 0;
}
SAVESPTR(PL_last_in_gv);
}
else if (SvOK(sv) && GvIO(PL_last_in_gv))
- IoLINES(GvIOp(PL_last_in_gv)) = (long)SvIV(sv);
+ IoLINES(GvIOp(PL_last_in_gv)) = SvIV(sv);
break;
case '^':
Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO);
break;
case '=':
- IoPAGE_LEN(GvIOp(PL_defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '-':
- IoLINES_LEFT(GvIOp(PL_defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L)
IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L;
break;
case '%':
- IoPAGE(GvIOp(PL_defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ IoPAGE(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '|':
{
Signal_t
Perl_sighandler(int sig)
{
-#if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
- dTHXa(PL_curinterp); /* fake TLS, because signals don't do TLS */
+#ifdef PERL_GET_SIG_CONTEXT
+ dTHXa(PERL_GET_SIG_CONTEXT);
#else
dTHX;
#endif
U32 flags = 0;
XPV *tXpv = PL_Xpv;
-#if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
- PERL_SET_THX(aTHX); /* fake TLS, see above */
-#endif
-
if (PL_savestack_ix + 15 <= PL_savestack_max)
flags |= 1;
if (PL_markstack_ptr < PL_markstack_max - 2)
SvREFCNT_dec(sig_sv);
#endif
}
+
+
+
projects / p5sagit/p5-mst-13.2.git / blobdiff