#define CALLOP this->*PL_op
#else
#define CALLOP *PL_op
+static void *docatch_body _((va_list args));
static OP *docatch _((OP *o));
static OP *dofindlabel _((OP *o, char *label, OP **opstack, OP **oplimit));
static void doparseform _((SV *sv));
static I32 sortcv _((SV *a, SV *b));
static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b)));
static OP *doeval _((int gimme, OP** startop));
-static PerlIO *doopen _((const char *name, const char *mode));
+static PerlIO *doopen_pmc _((const char *name, const char *mode));
static I32 sv_ncmp _((SV *a, SV *b));
static I32 sv_i_ncmp _((SV *a, SV *b));
static I32 amagic_ncmp _((SV *a, SV *b));
if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
s == m, cx->sb_targ, NULL,
((cx->sb_rflags & REXEC_COPY_STR)
- ? REXEC_IGNOREPOS
- : (REXEC_COPY_STR|REXEC_IGNOREPOS))))
+ ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
+ : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
{
SV *targ = cx->sb_targ;
sv_catpvn(dstr, s, cx->sb_strend - s);
RETURNOP(pm->op_next);
}
}
- if (rx->subbase && rx->subbase != orig) {
+ if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
m = s;
s = orig;
- cx->sb_orig = orig = rx->subbase;
+ cx->sb_orig = orig = rx->subbeg;
s = orig + (m - s);
cx->sb_strend = s + (cx->sb_strend - m);
}
- cx->sb_m = m = rx->startp[0];
+ cx->sb_m = m = rx->startp[0] + orig;
sv_catpvn(dstr, s, m-s);
- cx->sb_s = rx->endp[0];
+ cx->sb_s = rx->endp[0] + orig;
cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
rxres_save(&cx->sb_rxres, rx);
RETURNOP(pm->op_pmreplstart);
*rsp = (void*)p;
}
- *p++ = (UV)rx->subbase;
- rx->subbase = Nullch;
+ *p++ = (UV)(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
+ RX_MATCH_COPIED_off(rx);
*p++ = rx->nparens;
*p++ = (UV)rx->subbeg;
- *p++ = (UV)rx->subend;
+ *p++ = (UV)rx->sublen;
for (i = 0; i <= rx->nparens; ++i) {
*p++ = (UV)rx->startp[i];
*p++ = (UV)rx->endp[i];
UV *p = (UV*)*rsp;
U32 i;
- Safefree(rx->subbase);
- rx->subbase = (char*)(*p);
+ if (RX_MATCH_COPIED(rx))
+ Safefree(rx->subbeg);
+ RX_MATCH_COPIED_set(rx, *p);
*p++ = 0;
rx->nparens = *p++;
rx->subbeg = (char*)(*p++);
- rx->subend = (char*)(*p++);
+ rx->sublen = (I32)(*p++);
for (i = 0; i <= rx->nparens; ++i) {
- rx->startp[i] = (char*)(*p++);
- rx->endp[i] = (char*)(*p++);
+ rx->startp[i] = (I32)(*p++);
+ rx->endp[i] = (I32)(*p++);
}
}
if (PL_stack_base + *PL_markstack_ptr == SP) {
(void)POPMARK;
if (GIMME_V == G_SCALAR)
- XPUSHs(&PL_sv_no);
+ XPUSHs(sv_2mortal(newSViv(0)));
RETURNOP(PL_op->op_next->op_next);
}
PL_stack_sp = PL_stack_base + *PL_markstack_ptr + 1;
{
if (GIMME == G_ARRAY)
return cCONDOP->op_true;
- return SvTRUEx(PAD_SV(PL_op->op_targ)) ? cCONDOP->op_false : cCONDOP->op_true;
+ if (SvTRUEx(PAD_SV(PL_op->op_targ)))
+ return cCONDOP->op_false;
+ else
+ return cCONDOP->op_true;
}
PP(pp_flip)
SV **newsp;
if (message) {
- if (PL_in_eval & 4) {
+ if (PL_in_eval & EVAL_KEEPERR) {
SV **svp;
svp = hv_fetch(ERRHV, message, msglen, TRUE);
}
}
+STATIC void *
+docatch_body(va_list args)
+{
+ CALLRUNOPS();
+ return NULL;
+}
+
STATIC OP *
docatch(OP *o)
{
dTHR;
int ret;
OP *oldop = PL_op;
- dJMPENV;
- PL_op = o;
#ifdef DEBUGGING
assert(CATCH_GET == TRUE);
- DEBUG_l(deb("Setting up local jumplevel %p, was %p\n", &cur_env, PL_top_env));
#endif
- JMPENV_PUSH(ret);
+ PL_op = o;
+ redo_body:
+ CALLPROTECT(&ret, FUNC_NAME_TO_PTR(docatch_body));
switch (ret) {
- default: /* topmost level handles it */
-pass_the_buck:
- JMPENV_POP;
+ case 0:
+ break;
+ case 3:
+ if (PL_restartop) {
+ PL_op = PL_restartop;
+ PL_restartop = 0;
+ goto redo_body;
+ }
+ /* FALL THROUGH */
+ default:
PL_op = oldop;
JMPENV_JUMP(ret);
/* NOTREACHED */
- case 3:
- if (!PL_restartop)
- goto pass_the_buck;
- PL_op = PL_restartop;
- PL_restartop = 0;
- /* FALL THROUGH */
- case 0:
- CALLRUNOPS();
- break;
}
- JMPENV_POP;
PL_op = oldop;
return Nullop;
}
AV* comppadlist;
I32 i;
- PL_in_eval = 1;
+ PL_in_eval = EVAL_INEVAL;
PUSHMARK(SP);
SvREFCNT_dec(PL_rs);
PL_rs = newSVpvn("\n", 1);
if (saveop && saveop->op_flags & OPf_SPECIAL)
- PL_in_eval |= 4;
+ PL_in_eval |= EVAL_KEEPERR;
else
sv_setpv(ERRSV,"");
if (yyparse() || PL_error_count || !PL_eval_root) {
RETURNOP(PL_eval_start);
}
-static PerlIO *
-doopen(const char *name, const char *mode)
+STATIC PerlIO *
+doopen_pmc(const char *name, const char *mode)
{
STRLEN namelen = strlen(name);
PerlIO *fp;
if (namelen > 3 && strcmp(name + namelen - 3, ".pm") == 0) {
- SV *pmcsv = newSVpvf("%s%c", name, 'c');
+ SV *pmcsv = newSVpvf("%s%c", name, 'c');
char *pmc = SvPV_nolen(pmcsv);
Stat_t pmstat;
- Stat_t pmcstat;
- if (PerlLIO_stat(pmc, &pmcstat) < 0) {
+ Stat_t pmcstat;
+ if (PerlLIO_stat(pmc, &pmcstat) < 0) {
fp = PerlIO_open(name, mode);
- } else {
+ }
+ else {
if (PerlLIO_stat(name, &pmstat) < 0 ||
- pmstat.st_mtime < pmcstat.st_mtime) {
- fp = PerlIO_open(pmc, mode);
- } else {
- fp = PerlIO_open(name, mode);
- }
+ pmstat.st_mtime < pmcstat.st_mtime)
+ {
+ fp = PerlIO_open(pmc, mode);
+ }
+ else {
+ fp = PerlIO_open(name, mode);
+ }
}
- SvREFCNT_dec(pmcsv);
- } else {
- fp = PerlIO_open(name, mode);
+ SvREFCNT_dec(pmcsv);
+ }
+ else {
+ fp = PerlIO_open(name, mode);
}
-
return fp;
}
)
{
tryname = name;
- tryrsfp = doopen(name,PERL_SCRIPT_MODE);
+ tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE);
}
else {
AV *ar = GvAVn(PL_incgv);
#endif
TAINT_PROPER("require");
tryname = SvPVX(namesv);
- tryrsfp = doopen(tryname, PERL_SCRIPT_MODE);
+ tryrsfp = doopen_pmc(tryname, PERL_SCRIPT_MODE);
if (tryrsfp) {
if (tryname[0] == '.' && tryname[1] == '/')
tryname += 2;
SvREFCNT_dec(namesv);
if (!tryrsfp) {
if (PL_op->op_type == OP_REQUIRE) {
- SV *msg = sv_2mortal(newSVpvf("Can't locate %s in @INC", name));
- SV *dirmsgsv = NEWSV(0, 0);
- AV *ar = GvAVn(PL_incgv);
- I32 i;
- if (instr(SvPVX(msg), ".h "))
- sv_catpv(msg, " (change .h to .ph maybe?)");
- if (instr(SvPVX(msg), ".ph "))
- sv_catpv(msg, " (did you run h2ph?)");
- sv_catpv(msg, " (@INC contains:");
- for (i = 0; i <= AvFILL(ar); i++) {
- char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
- sv_setpvf(dirmsgsv, " %s", dir);
- sv_catsv(msg, dirmsgsv);
+ char *msgstr = name;
+ if (namesv) { /* did we lookup @INC? */
+ SV *msg = sv_2mortal(newSVpv(msgstr,0));
+ SV *dirmsgsv = NEWSV(0, 0);
+ AV *ar = GvAVn(PL_incgv);
+ I32 i;
+ sv_catpvn(msg, " in @INC", 8);
+ if (instr(SvPVX(msg), ".h "))
+ sv_catpv(msg, " (change .h to .ph maybe?)");
+ if (instr(SvPVX(msg), ".ph "))
+ sv_catpv(msg, " (did you run h2ph?)");
+ sv_catpv(msg, " (@INC contains:");
+ for (i = 0; i <= AvFILL(ar); i++) {
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
+ sv_setpvf(dirmsgsv, " %s", dir);
+ sv_catsv(msg, dirmsgsv);
+ }
+ sv_catpvn(msg, ")", 1);
+ SvREFCNT_dec(dirmsgsv);
+ msgstr = SvPV_nolen(msg);
}
- sv_catpvn(msg, ")", 1);
- SvREFCNT_dec(dirmsgsv);
- DIE("%_", msg);
+ DIE("Can't locate %s", msgstr);
}
RETPUSHUNDEF;
PUSHEVAL(cx, 0, 0);
PL_eval_root = PL_op; /* Only needed so that goto works right. */
- PL_in_eval = 1;
+ PL_in_eval = EVAL_INEVAL;
sv_setpv(ERRSV,"");
PUTBACK;
return DOCATCH(PL_op->op_next);
projects / p5sagit/p5-mst-13.2.git / blobdiff