/* mg.c
*
- * Copyright (c) 1991-2002, Larry Wall
+ * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ * 2000, 2001, 2002, 2003, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
# endif
#endif
+#ifdef __hpux
+# include <sys/pstat.h>
+#endif
+
+Signal_t Perl_csighandler(int sig);
+
/* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */
#if !defined(HAS_SIGACTION) && defined(VMS)
# define FAKE_PERSISTENT_SIGNAL_HANDLERS
{
MGS* mgs;
assert(SvMAGICAL(sv));
+#ifdef PERL_COPY_ON_WRITE
+ /* Turning READONLY off for a copy-on-write scalar is a bad idea. */
+ if (SvIsCOW(sv))
+ sv_force_normal(sv);
+#endif
SAVEDESTRUCTOR_X(restore_magic, INT2PTR(void*, (IV)mgs_ix));
if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg);
+
+ /* guard against sv having been freed */
+ if (SvTYPE(sv) == SVTYPEMASK) {
+ Perl_croak(aTHX_ "Tied variable freed while still in use");
+ }
+
/* Don't restore the flags for this entry if it was deleted. */
if (mg->mg_flags & MGf_GSKIP)
(SSPTR(mgs_ix, MGS *))->mgs_flags = 0;
else /* @- */
i = s;
- if (i > 0 && PL_reg_match_utf8) {
+ if (i > 0 && RX_MATCH_UTF8(rx)) {
char *b = rx->subbeg;
if (b)
i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
{
i = t1 - s1;
getlen:
- if (i > 0 && PL_reg_match_utf8) {
+ if (i > 0 && RX_MATCH_UTF8(rx)) {
char *s = rx->subbeg + s1;
char *send = rx->subbeg + t1;
sv_setiv(sv, (IV)PL_perldb);
break;
case '\023': /* ^S */
- {
+ if (*(mg->mg_ptr+1) == '\0') {
if (PL_lex_state != LEX_NOTPARSING)
(void)SvOK_off(sv);
else if (PL_in_eval)
#endif
}
else if (strEQ(mg->mg_ptr, "\024AINT"))
- sv_setiv(sv, PL_tainting);
+ sv_setiv(sv, PL_tainting
+ ? (PL_taint_warn || PL_unsafe ? -1 : 1)
+ : 0);
break;
- case '\027': /* ^W & $^WARNING_BITS & ^WIDE_SYSTEM_CALLS */
+ case '\025': /* $^UNICODE */
+ if (strEQ(mg->mg_ptr, "\025NICODE"))
+ sv_setuv(sv, (UV) PL_unicode);
+ break;
+ case '\027': /* ^W & $^WARNING_BITS */
if (*(mg->mg_ptr+1) == '\0')
sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE));
else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
}
else if (PL_compiling.cop_warnings == pWARN_ALL) {
- sv_setpvn(sv, WARN_ALLstring, WARNsize) ;
+ /* Get the bit mask for $warnings::Bits{all}, because
+ * it could have been extended by warnings::register */
+ SV **bits_all;
+ HV *bits=get_hv("warnings::Bits", FALSE);
+ if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
+ sv_setsv(sv, *bits_all);
+ }
+ else {
+ sv_setpvn(sv, WARN_ALLstring, WARNsize) ;
+ }
}
else {
sv_setsv(sv, PL_compiling.cop_warnings);
}
SvPOK_only(sv);
}
- else if (strEQ(mg->mg_ptr+1, "IDE_SYSTEM_CALLS"))
- sv_setiv(sv, (IV)PL_widesyscalls);
break;
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': case '&':
getrx:
if (i >= 0) {
- bool was_tainted = FALSE;
- if (PL_tainting) {
- was_tainted = PL_tainted;
- PL_tainted = FALSE;
- }
sv_setpvn(sv, s, i);
- if (PL_reg_match_utf8 && is_utf8_string((U8*)s, i))
+ if (RX_MATCH_UTF8(rx) && is_utf8_string((U8*)s, i))
SvUTF8_on(sv);
else
SvUTF8_off(sv);
- if (PL_tainting)
- PL_tainted = (was_tainted || RX_MATCH_TAINTED(rx));
+ if (PL_tainting) {
+ if (RX_MATCH_TAINTED(rx)) {
+ MAGIC* mg = SvMAGIC(sv);
+ MAGIC* mgt;
+ PL_tainted = 1;
+ SvMAGIC(sv) = mg->mg_moremagic;
+ SvTAINT(sv);
+ if ((mgt = SvMAGIC(sv))) {
+ mg->mg_moremagic = mgt;
+ SvMAGIC(sv) = mg;
+ }
+ } else
+ SvTAINTED_off(sv);
+ }
break;
}
}
break;
case '\\':
if (PL_ors_sv)
- sv_setpv(sv,SvPVX(PL_ors_sv));
+ sv_copypv(sv, PL_ors_sv);
break;
case '#':
sv_setpv(sv,PL_ofmt);
#endif
(void)SvIOK_on(sv); /* what a wonderful hack! */
break;
- case '*':
- break;
#ifndef MACOS_TRADITIONAL
case '0':
break;
#endif
-#ifdef USE_5005THREADS
- case '@':
- sv_setsv(sv, thr->errsv);
- break;
-#endif /* USE_5005THREADS */
}
return 0;
}
#if defined(VMS) || defined(EPOC)
Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
#else
-# if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
+# if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
PerlEnv_clearenv();
-# else
-# ifdef USE_ENVIRON_ARRAY
-# ifndef PERL_USE_SAFE_PUTENV
+# else
+# ifdef USE_ENVIRON_ARRAY
+# if defined(USE_ITHREADS)
+ /* only the parent thread can clobber the process environment */
+ if (PL_curinterp == aTHX)
+# endif
+ {
+# ifndef PERL_USE_SAFE_PUTENV
I32 i;
if (environ == PL_origenviron)
else
for (i = 0; environ[i]; i++)
safesysfree(environ[i]);
-# endif /* PERL_USE_SAFE_PUTENV */
+# endif /* PERL_USE_SAFE_PUTENV */
environ[0] = Nullch;
-
-# endif /* USE_ENVIRON_ARRAY */
+ }
+# endif /* USE_ENVIRON_ARRAY */
# endif /* PERL_IMPLICIT_SYS || WIN32 */
#endif /* VMS || EPC */
return 0;
#endif
#ifndef PERL_MICRO
+#ifdef HAS_SIGPROCMASK
+static void
+restore_sigmask(pTHX_ SV *save_sv)
+{
+ sigset_t *ossetp = (sigset_t *) SvPV_nolen( save_sv );
+ (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
+}
+#endif
int
Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
{
STRLEN n_a;
/* Are we fetching a signal entry? */
i = whichsig(MgPV(mg,n_a));
- if (i) {
+ if (i > 0) {
if(PL_psig_ptr[i])
sv_setsv(sv,PL_psig_ptr[i]);
else {
int
Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
{
- I32 i;
+ /* XXX Some of this code was copied from Perl_magic_setsig. A little
+ * refactoring might be in order.
+ */
+ register char *s;
STRLEN n_a;
- /* Are we clearing a signal entry? */
- i = whichsig(MgPV(mg,n_a));
- if (i) {
- if(PL_psig_ptr[i]) {
- SvREFCNT_dec(PL_psig_ptr[i]);
- PL_psig_ptr[i]=0;
- }
- if(PL_psig_name[i]) {
- SvREFCNT_dec(PL_psig_name[i]);
- PL_psig_name[i]=0;
- }
+ SV* to_dec;
+ s = MgPV(mg,n_a);
+ if (*s == '_') {
+ SV** svp;
+ if (strEQ(s,"__DIE__"))
+ svp = &PL_diehook;
+ else if (strEQ(s,"__WARN__"))
+ svp = &PL_warnhook;
+ else
+ Perl_croak(aTHX_ "No such hook: %s", s);
+ if (*svp) {
+ to_dec = *svp;
+ *svp = 0;
+ SvREFCNT_dec(to_dec);
+ }
+ }
+ else {
+ I32 i;
+ /* Are we clearing a signal entry? */
+ i = whichsig(s);
+ if (i > 0) {
+#ifdef HAS_SIGPROCMASK
+ sigset_t set, save;
+ SV* save_sv;
+ /* Avoid having the signal arrive at a bad time, if possible. */
+ sigemptyset(&set);
+ sigaddset(&set,i);
+ sigprocmask(SIG_BLOCK, &set, &save);
+ ENTER;
+ save_sv = newSVpv((char *)(&save), sizeof(sigset_t));
+ SAVEFREESV(save_sv);
+ SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
+#endif
+ PERL_ASYNC_CHECK();
+#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
+ if (!sig_handlers_initted) Perl_csighandler_init();
+#endif
+#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
+ sig_defaulting[i] = 1;
+ (void)rsignal(i, &Perl_csighandler);
+#else
+ (void)rsignal(i, SIG_DFL);
+#endif
+ if(PL_psig_name[i]) {
+ SvREFCNT_dec(PL_psig_name[i]);
+ PL_psig_name[i]=0;
+ }
+ if(PL_psig_ptr[i]) {
+ to_dec=PL_psig_ptr[i];
+ PL_psig_ptr[i]=0;
+ LEAVE;
+ SvREFCNT_dec(to_dec);
+ }
+ else
+ LEAVE;
+ }
}
return 0;
}
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);
-#else
- Perl_raise_signal(aTHX_ sig);
-#endif
+ if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
+ /* Call the perl level handler now--
+ * with risk we may be in malloc() etc. */
+ (*PL_sighandlerp)(sig);
+ else
+ Perl_raise_signal(aTHX_ sig);
}
#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
PL_sig_pending = 0;
for (sig = 1; sig < SIG_SIZE; sig++) {
if (PL_psig_pend[sig]) {
- PL_psig_pend[sig] = 0;
+ PERL_BLOCKSIG_ADD(set, sig);
+ PL_psig_pend[sig] = 0;
+ PERL_BLOCKSIG_BLOCK(set);
(*PL_sighandlerp)(sig);
+ PERL_BLOCKSIG_UNBLOCK(set);
}
}
}
register char *s;
I32 i;
SV** svp = 0;
+ /* Need to be careful with SvREFCNT_dec(), because that can have side
+ * effects (due to closures). We must make sure that the new disposition
+ * is in place before it is called.
+ */
+ SV* to_dec = 0;
STRLEN len;
+#ifdef HAS_SIGPROCMASK
+ sigset_t set, save;
+ SV* save_sv;
+#endif
s = MgPV(mg,len);
if (*s == '_') {
Perl_croak(aTHX_ "No such hook: %s", s);
i = 0;
if (*svp) {
- SvREFCNT_dec(*svp);
+ to_dec = *svp;
*svp = 0;
}
}
else {
i = whichsig(s); /* ...no, a brick */
- if (!i) {
+ if (i < 0) {
if (ckWARN(WARN_SIGNAL))
Perl_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", s);
return 0;
}
+#ifdef HAS_SIGPROCMASK
+ /* Avoid having the signal arrive at a bad time, if possible. */
+ sigemptyset(&set);
+ sigaddset(&set,i);
+ sigprocmask(SIG_BLOCK, &set, &save);
+ ENTER;
+ save_sv = newSVpv((char *)(&save), sizeof(sigset_t));
+ SAVEFREESV(save_sv);
+ SAVEDESTRUCTOR_X(restore_sigmask, save_sv);
+#endif
+ PERL_ASYNC_CHECK();
#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)
if (!sig_handlers_initted) Perl_csighandler_init();
#endif
sig_ignoring[i] = 0;
#endif
#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS
- sig_defaulting[i] = 0;
+ sig_defaulting[i] = 0;
#endif
SvREFCNT_dec(PL_psig_name[i]);
- SvREFCNT_dec(PL_psig_ptr[i]);
+ to_dec = PL_psig_ptr[i];
PL_psig_ptr[i] = SvREFCNT_inc(sv);
SvTEMP_off(sv); /* Make sure it doesn't go away on us */
PL_psig_name[i] = newSVpvn(s, len);
SvREADONLY_on(PL_psig_name[i]);
}
if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
- if (i)
+ if (i) {
(void)rsignal(i, &Perl_csighandler);
+#ifdef HAS_SIGPROCMASK
+ LEAVE;
+#endif
+ }
else
*svp = SvREFCNT_inc(sv);
+ if(to_dec)
+ SvREFCNT_dec(to_dec);
return 0;
}
s = SvPV_force(sv,len);
#else
(void)rsignal(i, SIG_IGN);
#endif
- } else
- *svp = 0;
+ }
}
else if (strEQ(s,"DEFAULT") || !*s) {
if (i)
#else
(void)rsignal(i, SIG_DFL);
#endif
- else
- *svp = 0;
}
else {
/*
else
*svp = SvREFCNT_inc(sv);
}
+#ifdef HAS_SIGPROCMASK
+ if(i)
+ LEAVE;
+#endif
+ if(to_dec)
+ SvREFCNT_dec(to_dec);
return 0;
}
#endif /* !PERL_MICRO */
i = SvTRUE(sv);
svp = av_fetch(GvAV(gv),
atoi(MgPV(mg,n_a)), FALSE);
- if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp))))
- o->op_private = (U8)i;
+ if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp)))) {
+ /* set or clear breakpoint in the relevant control op */
+ if (i)
+ o->op_flags |= OPf_SPECIAL;
+ else
+ o->op_flags &= ~OPf_SPECIAL;
+ }
return 0;
}
if (LvTARGLEN(sv)) {
if (mg->mg_obj) {
SV *ahv = LvTARG(sv);
- if (SvTYPE(ahv) == SVt_PVHV) {
- HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0);
- if (he)
- targ = HeVAL(he);
- }
- else {
- SV **svp = avhv_fetch_ent((AV*)ahv, mg->mg_obj, FALSE, 0);
- if (svp)
- targ = *svp;
- }
+ HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, FALSE, 0);
+ if (he)
+ targ = HeVAL(he);
}
else {
AV* av = (AV*)LvTARG(sv);
if (mg->mg_obj) {
SV *ahv = LvTARG(sv);
STRLEN n_a;
- if (SvTYPE(ahv) == SVt_PVHV) {
- HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0);
- if (he)
- value = HeVAL(he);
- }
- else {
- SV **svp = avhv_fetch_ent((AV*)ahv, mg->mg_obj, TRUE, 0);
- if (svp)
- value = *svp;
- }
+ HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0);
+ if (he)
+ value = HeVAL(he);
if (!value || value == &PL_sv_undef)
Perl_croak(aTHX_ PL_no_helem, SvPV(mg->mg_obj, n_a));
}
}
int
+Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
+{
+ sv_unmagic(sv, PERL_MAGIC_qr);
+ return 0;
+}
+
+int
Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg)
{
regexp *re = (regexp *)mg->mg_obj;
}
#endif /* USE_LOCALE_COLLATE */
+/* Just clear the UTF-8 cache data. */
+int
+Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
+{
+ Safefree(mg->mg_ptr); /* The mg_ptr holds the pos cache. */
+ mg->mg_ptr = 0;
+ mg->mg_len = -1; /* The mg_len holds the len cache. */
+ return 0;
+}
+
int
Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
{
break;
case '\004': /* ^D */
- PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
+#ifdef DEBUGGING
+ s = SvPV_nolen(sv);
+ PL_debug = get_debug_opts(&s) | DEBUG_TOP_FLAG;
DEBUG_x(dump_all());
+#else
+ PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | DEBUG_TOP_FLAG;
+#endif
break;
case '\005': /* ^E */
- if (*(mg->mg_ptr+1) == '\0') {
+ if (*(mg->mg_ptr+1) == '\0') {
#ifdef MACOS_TRADITIONAL
- gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+ gMacPerl_OSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
#else
# ifdef VMS
- set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
# else
# ifdef WIN32
- SetLastError( SvIV(sv) );
+ SetLastError( SvIV(sv) );
# else
# ifdef OS2
- os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+ os2_setsyserrno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
# else
- /* will anyone ever use this? */
- SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
+ /* will anyone ever use this? */
+ SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
# endif
# endif
# endif
#endif
- }
- else if (strEQ(mg->mg_ptr+1, "NCODING")) {
- if (PL_encoding)
- sv_setsv(PL_encoding, sv);
- else
- PL_encoding = newSVsv(sv);
- }
+ }
+ else if (strEQ(mg->mg_ptr+1, "NCODING")) {
+ if (PL_encoding)
+ SvREFCNT_dec(PL_encoding);
+ if (SvOK(sv) || SvGMAGICAL(sv)) {
+ PL_encoding = newSVsv(sv);
+ }
+ else {
+ PL_encoding = Nullsv;
+ }
+ }
+ break;
case '\006': /* ^F */
PL_maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
#endif
break;
- case '\027': /* ^W & $^WARNING_BITS & ^WIDE_SYSTEM_CALLS */
+ case '\027': /* ^W & $^WARNING_BITS */
if (*(mg->mg_ptr+1) == '\0') {
if ( ! (PL_dowarn & G_WARN_ALL_MASK)) {
i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
}
}
}
- else if (strEQ(mg->mg_ptr+1, "IDE_SYSTEM_CALLS"))
- PL_widesyscalls = (bool)SvTRUE(sv);
break;
case '.':
if (PL_localizing) {
}
}
break;
- case '*':
- i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
- PL_multiline = (i != 0);
- break;
case '/':
SvREFCNT_dec(PL_rs);
PL_rs = newSVsv(sv);
STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
break;
case '!':
+ {
+#ifdef VMS
+# define PERL_VMS_BANG vaxc$errno
+#else
+# define PERL_VMS_BANG 0
+#endif
SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0,
- (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
+ (SvIV(sv) == EVMSERR) ? 4 : PERL_VMS_BANG);
+ }
break;
case '<':
PL_uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
break;
#ifndef MACOS_TRADITIONAL
case '0':
+ LOCK_DOLLARZERO_MUTEX;
#ifdef HAS_SETPROCTITLE
/* The BSDs don't show the argv[] in ps(1) output, they
* show a string from the process struct and provide
# endif
}
#endif
- if (!PL_origalen) {
- s = PL_origargv[0];
- s += strlen(s);
- /* See if all the arguments are contiguous in memory */
- for (i = 1; i < PL_origargc; i++) {
- if (PL_origargv[i] == s + 1
-#ifdef OS2
- || PL_origargv[i] == s + 2
-#endif
- )
- {
- ++s;
- s += strlen(s); /* this one is ok too */
- }
- else
- break;
- }
- /* can grab env area too? */
- if (PL_origenviron && (PL_origenviron[0] == s + 1)) {
- my_setenv("NoNe SuCh", Nullch);
- /* force copy of environment */
- for (i = 0; PL_origenviron[i]; i++)
- if (PL_origenviron[i] == s + 1) {
- ++s;
- s += strlen(s);
- }
- else
- break;
- }
- PL_origalen = s - PL_origargv[0];
+#if defined(__hpux) && defined(PSTAT_SETCMD)
+ {
+ union pstun un;
+ s = SvPV(sv, len);
+ un.pst_command = s;
+ pstat(PSTAT_SETCMD, un, len, 0, 0);
}
+#endif
+ /* PL_origalen is set in perl_parse(). */
s = SvPV_force(sv,len);
- i = len;
- if (i >= (I32)PL_origalen) {
- i = PL_origalen;
- /* don't allow system to limit $0 seen by script */
- /* SvCUR_set(sv, i); *SvEND(sv) = '\0'; */
- Copy(s, PL_origargv[0], i, char);
- s = PL_origargv[0]+i;
- *s = '\0';
+ if (len >= (I32)PL_origalen) {
+ /* Longer than original, will be truncated. */
+ Copy(s, PL_origargv[0], PL_origalen, char);
+ PL_origargv[0][PL_origalen - 1] = 0;
}
else {
- Copy(s, PL_origargv[0], i, char);
- s = PL_origargv[0]+i;
- *s++ = '\0';
- while (++i < (I32)PL_origalen)
- *s++ = ' ';
- s = PL_origargv[0]+i;
+ /* Shorter than original, will be padded. */
+ Copy(s, PL_origargv[0], len, char);
+ PL_origargv[0][len] = 0;
+ memset(PL_origargv[0] + len + 1,
+ /* Is the space counterintuitive? Yes.
+ * (You were expecting \0?)
+ * Does it work? Seems to. (In Linux 2.4.20 at least.)
+ * --jhi */
+ (int)' ',
+ PL_origalen - len - 1);
for (i = 1; i < PL_origargc; i++)
- PL_origargv[i] = Nullch;
+ PL_origargv[i] = 0;
}
+ UNLOCK_DOLLARZERO_MUTEX;
break;
#endif
-#ifdef USE_5005THREADS
- case '@':
- sv_setsv(thr->errsv, sv);
- break;
-#endif /* USE_5005THREADS */
}
return 0;
}
-#ifdef USE_5005THREADS
-int
-Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg)
-{
- DEBUG_S(PerlIO_printf(Perl_debug_log,
- "0x%"UVxf": magic_mutexfree 0x%"UVxf"\n",
- PTR2UV(thr), PTR2UV(sv)));
- if (MgOWNER(mg))
- Perl_croak(aTHX_ "panic: magic_mutexfree");
- MUTEX_DESTROY(MgMUTEXP(mg));
- COND_DESTROY(MgCONDP(mg));
- return 0;
-}
-#endif /* USE_5005THREADS */
-
I32
Perl_whichsig(pTHX_ char *sig)
{
register char **sigv;
- for (sigv = PL_sig_name+1; *sigv; sigv++)
+ for (sigv = PL_sig_name; *sigv; sigv++)
if (strEQ(sig,*sigv))
return PL_sig_num[sigv - PL_sig_name];
#ifdef SIGCLD
if (strEQ(sig,"CLD"))
return SIGCHLD;
#endif
- return 0;
+ return -1;
}
#if !defined(PERL_IMPLICIT_CONTEXT)
https://perl5.git.perl.org / perl5.git / blobdiff