# endif
#endif
-static void restore_magic(pTHXo_ void *p);
-static void unwind_handler_stack(pTHXo_ void *p);
+static void restore_magic(pTHX_ void *p);
+static void unwind_handler_stack(pTHX_ void *p);
/*
* Use the "DESTRUCTOR" scope cleanup to reinstate magic.
int
Perl_mg_get(pTHX_ SV *sv)
{
- I32 mgs_ix;
- MAGIC* mg;
- MAGIC** mgp;
- int mgp_valid = 0;
+ int new = 0;
+ MAGIC *newmg, *head, *cur, *mg;
+ I32 mgs_ix = SSNEW(sizeof(MGS));
- mgs_ix = SSNEW(sizeof(MGS));
save_magic(mgs_ix, sv);
- mgp = &SvMAGIC(sv);
- while ((mg = *mgp) != 0) {
- MGVTBL* vtbl = mg->mg_virtual;
+ /* We must call svt_get(sv, mg) for each valid entry in the linked
+ list of magic. svt_get() may delete the current entry, add new
+ magic to the head of the list, or upgrade the SV. AMS 20010810 */
+
+ newmg = cur = head = mg = SvMAGIC(sv);
+ while (mg) {
+ MGVTBL *vtbl = mg->mg_virtual;
+
if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg);
- /* Ignore this magic if it's been deleted */
- if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
- (mg->mg_flags & MGf_GSKIP))
- (SSPTR(mgs_ix, MGS*))->mgs_flags = 0;
+ /* 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;
}
- /* Advance to next magic (complicated by possible deletion) */
- if (mg == (mgp_valid ? *mgp : SvMAGIC(sv))) {
- mgp = &mg->mg_moremagic;
- mgp_valid = 1;
+
+ mg = mg->mg_moremagic;
+
+ if (new) {
+ /* Have we finished with the new entries we saw? Start again
+ where we left off (unless there are more new entries). */
+ if (mg == head) {
+ new = 0;
+ mg = cur;
+ head = newmg;
+ }
+ }
+
+ /* Were any new entries added? */
+ if (!new && (newmg = SvMAGIC(sv)) != head) {
+ new = 1;
+ cur = mg;
+ mg = newmg;
}
- else
- mgp = &SvMAGIC(sv); /* Re-establish pointer after sv_upgrade */
}
- restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+ restore_magic(aTHX_ INT2PTR(void *, (IV)mgs_ix));
return 0;
}
CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg);
}
- restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+ restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
return 0;
}
save_magic(mgs_ix, sv);
/* omit MGf_GSKIP -- not changed here */
len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
- restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+ restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
return len;
}
}
- (void)SvPV(sv, len);
+ if (DO_UTF8(sv))
+ {
+ U8 *s = (U8*)SvPV(sv, len);
+ len = Perl_utf8_length(aTHX_ s, s + len);
+ }
+ else
+ (void)SvPV(sv, len);
return len;
}
save_magic(mgs_ix, sv);
/* omit MGf_GSKIP -- not changed here */
len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg);
- restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+ restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
return len;
}
}
CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg);
}
- restore_magic(aTHXo_ INT2PTR(void*, (IV)mgs_ix));
+ restore_magic(aTHX_ INT2PTR(void*, (IV)mgs_ix));
return 0;
}
else /* @- */
i = s;
- if (i > 0 && DO_UTF8(PL_reg_sv)) {
+ if (i > 0 && PL_reg_match_utf8) {
char *b = rx->subbeg;
if (b)
i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
{
i = t1 - s1;
getlen:
- if (i > 0 && DO_UTF8(PL_reg_sv)) {
+ if (i > 0 && PL_reg_match_utf8) {
char *s = rx->subbeg + s1;
char *send = rx->subbeg + t1;
PL_tainted = FALSE;
}
sv_setpvn(sv, s, i);
- if (PL_reg_sv && DO_UTF8(PL_reg_sv) && is_utf8_string((U8*)s, i))
+ if (PL_reg_match_utf8 && is_utf8_string((U8*)s, i))
SvUTF8_on(sv);
else
SvUTF8_off(sv);
case '0':
break;
#endif
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
case '@':
sv_setsv(sv, thr->errsv);
break;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
}
return 0;
}
sv_insert(lsv, lvoff, lvlen, tmps, len);
SvUTF8_on(lsv);
}
- else if (SvUTF8(lsv)) {
+ else if (lsv && SvUTF8(lsv)) {
sv_pos_u2b(lsv, &lvoff, &lvlen);
tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
sv_insert(lsv, lvoff, lvlen, tmps, len);
PL_multiline = (i != 0);
break;
case '/':
- SvREFCNT_dec(PL_nrs);
- PL_nrs = newSVsv(sv);
SvREFCNT_dec(PL_rs);
- PL_rs = SvREFCNT_inc(PL_nrs);
+ PL_rs = newSVsv(sv);
break;
case '\\':
if (PL_ors_sv)
* the setproctitle() routine to manipulate that. */
{
s = SvPV(sv, len);
-# if __FreeBSD_version >= 410001
+# if __FreeBSD_version > 410001
/* The leading "-" removes the "perl: " prefix,
* but not the "(perl) suffix from the ps(1)
* output, because that's what ps(1) shows if the
* argv[] is modified. */
- setproctitle("-%s", s, len + 1);
+ setproctitle("-%s", s);
# else /* old FreeBSDs, NetBSD, OpenBSD, anyBSD */
/* This doesn't really work if you assume that
* $0 = 'foobar'; will wipe out 'perl' from the $0
break;
}
/* can grab env area too? */
- if (PL_origenviron && (PL_origenviron[0] == s + 1
-#ifdef OS2
- || (PL_origenviron[0] == s + 9 && (s += 8))
-#endif
- )) {
+ if (PL_origenviron && (PL_origenviron[0] == s + 1)) {
my_setenv("NoNe SuCh", Nullch);
/* force copy of environment */
for (i = 0; PL_origenviron[i]; i++)
}
break;
#endif
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
case '@':
sv_setsv(thr->errsv, sv);
break;
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
}
return 0;
}
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
int
Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg)
{
COND_DESTROY(MgCONDP(mg));
return 0;
}
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
I32
Perl_whichsig(pTHX_ char *sig)
Perl_sighandler(int sig)
{
#if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
- dTHXoa(PL_curinterp); /* fake TLS, because signals don't do TLS */
+ dTHXa(PL_curinterp); /* fake TLS, because signals don't do TLS */
#else
dTHX;
#endif
XPV *tXpv = PL_Xpv;
#if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
- PERL_SET_THX(aTHXo); /* fake TLS, see above */
+ PERL_SET_THX(aTHX); /* fake TLS, see above */
#endif
if (PL_savestack_ix + 15 <= PL_savestack_max)
(void)rsignal(sig, &Perl_csighandler);
#endif
#endif /* !PERL_MICRO */
- Perl_die(aTHX_ Nullch);
+ Perl_die(aTHX_ Nullformat);
}
cleanup:
if (flags & 1)
}
-#ifdef PERL_OBJECT
-#include "XSUB.h"
-#endif
-
static void
-restore_magic(pTHXo_ void *p)
+restore_magic(pTHX_ void *p)
{
MGS* mgs = SSPTR(PTR2IV(p), MGS*);
SV* sv = mgs->mgs_sv;
}
static void
-unwind_handler_stack(pTHXo_ void *p)
+unwind_handler_stack(pTHX_ void *p)
{
U32 flags = *(U32*)p;
projects / p5sagit/p5-mst-13.2.git / blobdiff