/* Hot code. */
-#ifdef USE_THREADS
-static void unset_cvowner(pTHXo_ void *cvarg);
-#endif /* USE_THREADS */
+#ifdef USE_5005THREADS
+static void unset_cvowner(pTHX_ void *cvarg);
+#endif /* USE_5005THREADS */
PP(pp_const)
{
/* Unless the left argument is integer in range we are going to have to
use NV maths. Hence only attempt to coerce the right argument if
we know the left is integer. */
- register UV auv;
- bool auvok;
+ register UV auv = 0;
+ bool auvok = FALSE;
bool a_valid = 0;
if (!useleft) {
gv = (GV*)*++MARK;
else
gv = PL_defoutgv;
- if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) {
+
+ if (gv && (io = GvIO(gv))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
+ {
had_magic:
if (MARK == ORIGMARK) {
/* If using default handle then we need to make space to
++SP;
}
PUSHMARK(MARK - 1);
- *MARK = SvTIED_obj((SV*)gv, mg);
+ *MARK = SvTIED_obj((SV*)io, mg);
PUTBACK;
ENTER;
call_method("PRINT", G_SCALAR);
RETURN;
}
if (!(io = GvIO(gv))) {
- if ((GvEGV(gv))
- && (mg = SvTIED_mg((SV*)GvEGV(gv), PERL_MAGIC_tiedscalar)))
+ if ((GvEGV(gv)) && (io = GvIO(GvEGV(gv)))
+ && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
goto had_magic;
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
register PMOP *pm = cPMOP;
SV *rv = sv_newmortal();
SV *sv = newSVrv(rv, "Regexp");
- sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp), PERL_MAGIC_qr,0,0);
+ sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
RETURNX(PUSHs(rv));
}
I32 global;
I32 r_flags = REXEC_CHECKED;
char *truebase; /* Start of string */
- register REGEXP *rx = pm->op_pmregexp;
+ register REGEXP *rx = PM_GETRE(pm);
bool rxtainted;
I32 gimme = GIMME;
STRLEN len;
TARG = DEFSV;
EXTEND(SP,1);
}
- PL_reg_sv = TARG;
+
PUTBACK; /* EVAL blocks need stack_sp. */
s = SvPV(TARG, len);
strend = s + len;
(PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
TAINT_NOT;
+ PL_reg_match_utf8 = DO_UTF8(TARG);
+
if (pm->op_pmdynflags & PMdf_USED) {
failure:
if (gimme == G_ARRAY)
if (!rx->prelen && PL_curpm) {
pm = PL_curpm;
- rx = pm->op_pmregexp;
+ rx = PM_GETRE(pm);
}
if (rx->minlen > len) goto failure;
len = rx->endp[i] - rx->startp[i];
s = rx->startp[i] + truebase;
sv_setpvn(*SP, s, len);
- if (DO_UTF8(TARG))
+ if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
SvUTF8_on(*SP);
}
}
if (global) {
+ if (pm->op_pmflags & PMf_CONTINUE) {
+ MAGIC* mg = 0;
+ if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
+ mg = mg_find(TARG, PERL_MAGIC_regex_global);
+ if (!mg) {
+ sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
+ mg = mg_find(TARG, PERL_MAGIC_regex_global);
+ }
+ if (rx->startp[0] != -1) {
+ mg->mg_len = rx->endp[0];
+ if (rx->startp[0] == rx->endp[0])
+ mg->mg_flags |= MGf_MINMATCH;
+ else
+ mg->mg_flags &= ~MGf_MINMATCH;
+ }
+ }
had_zerolen = (rx->startp[0] != -1
&& rx->startp[0] == rx->endp[0]);
PUTBACK; /* EVAL blocks may use stack */
if (global) {
rx->subbeg = truebase;
rx->startp[0] = s - truebase;
- if (DO_UTF8(PL_reg_sv)) {
+ if (PL_reg_match_utf8) {
char *t = (char*)utf8_hop((U8*)s, rx->minlen);
rx->endp[0] = t - truebase;
}
I32 gimme = GIMME_V;
MAGIC *mg;
- if ((mg = SvTIED_mg((SV*)PL_last_in_gv, PERL_MAGIC_tiedscalar))) {
+ if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
PUSHMARK(SP);
- XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg));
+ XPUSHs(SvTIED_obj((SV*)io, mg));
PUTBACK;
ENTER;
call_method("READLINE", gimme);
U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
- I32 preeminent;
+ I32 preeminent = 0;
if (SvTYPE(hv) == SVt_PVHV) {
if (PL_op->op_private & OPpLVAL_INTRO)
SP = newsp;
else if (gimme == G_SCALAR) {
MARK = newsp + 1;
- if (MARK <= SP)
+ if (MARK <= SP) {
if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
*MARK = TOPs;
else
*MARK = sv_mortalcopy(TOPs);
- else {
+ } else {
MEXTEND(mark,0);
*MARK = &PL_sv_undef;
}
STRLEN maxlen;
char *max = SvPV((SV*)av, maxlen);
if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
-#ifndef USE_THREADS /* don't risk potential race */
+#ifndef USE_5005THREADS /* don't risk potential race */
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
sv_setsv(*itersvp, cur);
if (cx->blk_loop.iterix > cx->blk_loop.itermax)
RETPUSHNO;
-#ifndef USE_THREADS /* don't risk potential race */
+#ifndef USE_5005THREADS /* don't risk potential race */
if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
/* safe to reuse old SV */
sv_setiv(*itersvp, cx->blk_loop.iterix++);
bool rxtainted;
char *orig;
I32 r_flags;
- register REGEXP *rx = pm->op_pmregexp;
+ register REGEXP *rx = PM_GETRE(pm);
STRLEN len;
int force_on_match = 0;
I32 oldsave = PL_savestack_ix;
- bool do_utf8;
STRLEN slen;
/* known replacement string? */
TARG = DEFSV;
EXTEND(SP,1);
}
- PL_reg_sv = TARG;
- do_utf8 = DO_UTF8(PL_reg_sv);
+
if (SvFAKE(TARG) && SvREADONLY(TARG))
sv_force_normal(TARG);
if (SvREADONLY(TARG)
rxtainted |= 2;
TAINT_NOT;
+ PL_reg_match_utf8 = DO_UTF8(TARG);
+
force_it:
if (!pm || !s)
DIE(aTHX_ "panic: pp_subst");
strend = s + len;
- slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : len;
+ slen = PL_reg_match_utf8 ? utf8_length((U8*)s, (U8*)strend) : len;
maxiters = 2 * slen + 10; /* We can match twice at each
position, once with zero-length,
second time with non-zero. */
if (!rx->prelen && PL_curpm) {
pm = PL_curpm;
- rx = pm->op_pmregexp;
+ rx = PM_GETRE(pm);
}
r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
? REXEC_COPY_STR : 0;
else if (gimme == G_ARRAY) {
EXTEND_MORTAL(SP - newsp);
for (mark = newsp + 1; mark <= SP; mark++) {
- if (SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
+ if (*mark != &PL_sv_undef
+ && SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
/* Might be flattened array after $#array = */
PUTBACK;
POPSUB(cx,sv);
PL_curpm = newpm;
LEAVE;
LEAVESUB(sv);
- DIE(aTHX_ "Can't return %s from lvalue subroutine",
- (*mark != &PL_sv_undef)
- ? (SvREADONLY(TOPs)
- ? "a readonly value" : "a temporary")
- : "an uninitialized value");
+ DIE(aTHX_ "Can't return a %s from lvalue subroutine",
+ SvREADONLY(TOPs) ? "readonly value" : "temporary");
}
else {
/* Can be a localized value subject to deletion. */
}
if (SvGMAGICAL(sv)) {
mg_get(sv);
+ if (SvROK(sv))
+ goto got_rv;
sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
}
else
cv = get_cv(sym, TRUE);
break;
}
+ got_rv:
{
SV **sp = &sv; /* Used in tryAMAGICunDEREF macro. */
tryAMAGICunDEREF(to_cv);
DIE(aTHX_ "No DBsub routine");
}
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
/*
* First we need to check if the sub or method requires locking.
* If so, we gain a lock on the CV, the first argument or the
COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
MgOWNER(mg) = thr;
DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: pp_entersub lock %p\n",
- thr, sv);)
+ thr, sv));
MUTEX_UNLOCK(MgMUTEXP(mg));
SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
}
}
DEBUG_S(if (CvDEPTH(cv) != 0)
PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
- CvDEPTH(cv)););
+ CvDEPTH(cv)));
SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv);
}
}
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
if (CvXSUB(cv)) {
#ifdef PERL_XSUB_OLDSTYLE
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
AV* av;
I32 items;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
av = (AV*)PL_curpad[0];
#else
av = GvAV(PL_defgv);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
items = AvFILLp(av) + 1; /* @_ is not tieable */
if (items) {
PL_curcopdb = NULL;
}
/* Do we need to open block here? XXXX */
- (void)(*CvXSUB(cv))(aTHXo_ cv);
+ (void)(*CvXSUB(cv))(aTHX_ cv);
/* Enforce some sanity in scalar context. */
if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) {
svp = AvARRAY(padlist);
}
}
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
if (!hasargs) {
AV* av = (AV*)PL_curpad[0];
PUTBACK ;
}
}
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
SAVEVPTR(PL_curpad);
PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
-#ifndef USE_THREADS
+#ifndef USE_5005THREADS
if (hasargs)
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
{
AV* av;
SV** ary;
AvREAL_off(av);
AvREIFY_on(av);
}
-#ifndef USE_THREADS
+#ifndef USE_5005THREADS
cx->blk_sub.savearray = GvAV(PL_defgv);
GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
cx->blk_sub.oldcurpad = PL_curpad;
cx->blk_sub.argarray = av;
++MARK;
HV* stash;
char* name;
STRLEN namelen;
- char* packname;
+ char* packname = 0;
STRLEN packlen;
name = SvPV(meth, namelen);
return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
}
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
static void
-unset_cvowner(pTHXo_ void *cvarg)
+unset_cvowner(pTHX_ void *cvarg)
{
register CV* cv = (CV *) cvarg;
MUTEX_LOCK(CvMUTEXP(cv));
DEBUG_S(if (CvDEPTH(cv) != 0)
PerlIO_printf(Perl_debug_log, "depth %ld != 0\n",
- CvDEPTH(cv)););
+ CvDEPTH(cv)));
assert(thr == CvOWNER(cv));
CvOWNER(cv) = 0;
MUTEX_UNLOCK(CvMUTEXP(cv));
SvREFCNT_dec(cv);
}
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
projects / p5sagit/p5-mst-13.2.git / blobdiff