/* pp_ctl.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 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.
SV *tmpstr;
STRLEN len;
MAGIC *mg = Null(MAGIC*);
-
- tmpstr = POPs;
/* prevent recompiling under /o and ithreads. */
#if defined(USE_ITHREADS)
- if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm))
- RETURN;
+ if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm)) {
+ if (PL_op->op_flags & OPf_STACKED) {
+ dMARK;
+ SP = MARK;
+ }
+ else
+ (void)POPs;
+ RETURN;
+ }
#endif
+ if (PL_op->op_flags & OPf_STACKED) {
+ /* multiple args; concatentate them */
+ dMARK; dORIGMARK;
+ tmpstr = PAD_SV(ARGTARG);
+ sv_setpvn(tmpstr, "", 0);
+ while (++MARK <= SP) {
+ if (PL_amagic_generation) {
+ SV *sv;
+ if ((SvAMAGIC(tmpstr) || SvAMAGIC(*MARK)) &&
+ (sv = amagic_call(tmpstr, *MARK, concat_amg, AMGf_assign)))
+ {
+ sv_setsv(tmpstr, sv);
+ continue;
+ }
+ }
+ sv_catsv(tmpstr, *MARK);
+ }
+ SvSETMAGIC(tmpstr);
+ SP = ORIGMARK;
+ }
+ else
+ tmpstr = POPs;
if (SvROK(tmpstr)) {
SV *sv = SvRV(tmpstr);
SV *nsv = Nullsv;
REGEXP *old = PM_GETRE(pm);
if(old != rx) {
- if(old)
+ if(old)
ReREFCNT_dec(old);
PM_SETRE(pm,rx);
}
} else
#endif
{
- SvOOK_off(targ);
- if (SvLEN(targ))
- Safefree(SvPVX(targ));
+ SvPV_free(targ);
}
- SvPVX(targ) = SvPVX(dstr);
+ SvPV_set(targ, SvPVX(dstr));
SvCUR_set(targ, SvCUR(dstr));
SvLEN_set(targ, SvLEN(dstr));
if (DO_UTF8(dstr))
SvUTF8_on(targ);
- SvPVX(dstr) = 0;
+ SvPV_set(dstr, (char*)0);
sv_free(dstr);
TAINT_IF(cx->sb_rxtainted & 1);
}
cx->sb_m = m = rx->startp[0] + orig;
if (m > s) {
- if (DO_UTF8(dstr) && !SvUTF8(cx->sb_targ))
+ if (DO_UTF8(dstr) && !SvUTF8(cx->sb_targ))
sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
else
sv_catpvn(dstr, s, m-s);
bool targ_is_utf8 = FALSE;
SV * nsv = Nullsv;
OP * parseres = 0;
- char *fmt;
+ const char *fmt;
bool oneline;
if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
for (;;) {
DEBUG_f( {
- char *name = "???";
+ const char *name = "???";
arg = -1;
switch (*fpc) {
case FF_LITERAL: arg = fpc[1]; name = "LITERAL"; break;
case FF_MORE: name = "MORE"; break;
case FF_LINEMARK: name = "LINEMARK"; break;
case FF_END: name = "END"; break;
- case FF_0DECIMAL: name = "0DECIMAL"; break;
+ case FF_0DECIMAL: name = "0DECIMAL"; break;
case FF_LINESNGL: name = "LINESNGL"; break;
}
if (arg >= 0)
item = s = SvPV(sv, len);
itemsize = len;
if ((item_is_utf8 = DO_UTF8(sv)))
- itemsize = sv_len_utf8(sv);
+ itemsize = sv_len_utf8(sv);
if (itemsize) {
bool chopped = FALSE;
gotsome = TRUE;
gotsome = TRUE;
value = SvNV(sv);
/* overflow evidence */
- if (num_overflow(value, fieldsize, arg)) {
+ if (num_overflow(value, fieldsize, arg)) {
arg = fieldsize;
while (arg--)
*t++ = '#';
PP(pp_grepstart)
{
- dSP;
+ dVAR; dSP;
SV *src;
if (PL_stack_base + *PL_markstack_ptr == SP) {
PP(pp_mapwhile)
{
- dSP;
+ dVAR; dSP;
I32 gimme = GIMME_V;
I32 items = (SP - PL_stack_base) - *PL_markstack_ptr; /* how many new items */
I32 count;
* irrelevant. --jhi */
if (shift < count)
shift = count; /* Avoid shifting too often --Ben Tilly */
-
+
EXTEND(SP,shift);
src = SP;
dst = (SP += shift);
while (items-- > 0)
*dst-- = SvTEMP(TOPs) ? POPs : sv_mortalcopy(POPs);
}
- else {
+ else {
/* scalar context: we don't care about which values map returns
* (we use undef here). And so we certainly don't want to do mortal
* copies of meaningless values. */
else {
dTOPss;
SV *targ = PAD_SV(PL_op->op_targ);
- int flip = 0;
+ int flip = 0;
- if (PL_op->op_private & OPpFLIP_LINENUM) {
+ if (PL_op->op_private & OPpFLIP_LINENUM) {
if (GvIO(PL_last_in_gv)) {
flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
}
GV *gv = gv_fetchpv(".", TRUE, SVt_PV);
if (gv && GvSV(gv)) flip = SvIV(sv) == SvIV(GvSV(gv));
}
- } else {
- flip = SvTRUE(sv);
- }
- if (flip) {
+ } else {
+ flip = SvTRUE(sv);
+ }
+ if (flip) {
sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
if (PL_op->op_flags & OPf_SPECIAL) {
sv_setiv(targ, 1);
/* Control. */
-static char *context_name[] = {
+static const char * const context_name[] = {
"pseudo-block",
"subroutine",
"eval",
};
STATIC I32
-S_dopoptolabel(pTHX_ char *label)
+S_dopoptolabel(pTHX_ const char *label)
{
register I32 i;
- register PERL_CONTEXT *cx;
for (i = cxstack_ix; i >= 0; i--) {
- cx = &cxstack[i];
+ register const PERL_CONTEXT *cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
case CXt_SUB:
I32
Perl_block_gimme(pTHX)
{
- I32 cxix;
-
- cxix = dopoptosub(cxstack_ix);
+ const I32 cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
return G_VOID;
I32
Perl_is_lvalue_sub(pTHX)
{
- I32 cxix;
-
- cxix = dopoptosub(cxstack_ix);
+ const I32 cxix = dopoptosub(cxstack_ix);
assert(cxix >= 0); /* We should only be called from inside subs */
if (cxstack[cxix].blk_sub.lval && CvLVALUE(cxstack[cxix].blk_sub.cv))
S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock)
{
I32 i;
- register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
- cx = &cxstk[i];
+ register const PERL_CONTEXT *cx = &cxstk[i];
switch (CxTYPE(cx)) {
default:
continue;
S_dopoptoeval(pTHX_ I32 startingblock)
{
I32 i;
- register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
- cx = &cxstack[i];
+ register const PERL_CONTEXT *cx = &cxstack[i];
switch (CxTYPE(cx)) {
default:
continue;
S_dopoptoloop(pTHX_ I32 startingblock)
{
I32 i;
- register PERL_CONTEXT *cx;
for (i = startingblock; i >= 0; i--) {
- cx = &cxstack[i];
+ register const PERL_CONTEXT *cx = &cxstack[i];
switch (CxTYPE(cx)) {
case CXt_SUBST:
case CXt_SUB:
void
Perl_dounwind(pTHX_ I32 cxix)
{
- register PERL_CONTEXT *cx;
I32 optype;
while (cxstack_ix > cxix) {
SV *sv;
- cx = &cxstack[cxstack_ix];
+ register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
(long) cxstack_ix, PL_block_type[CxTYPE(cx)]));
/* Note: we don't need to restore the base context info till the end. */
}
OP *
-Perl_die_where(pTHX_ char *message, STRLEN msglen)
+Perl_die_where(pTHX_ const char *message, STRLEN msglen)
{
+ dVAR;
STRLEN n_a;
if (PL_in_eval) {
I32 cxix;
- register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
if (message) {
if (PL_in_eval & EVAL_KEEPERR) {
- static char prefix[] = "\t(in cleanup) ";
+ static const char prefix[] = "\t(in cleanup) ";
SV *err = ERRSV;
- char *e = Nullch;
+ const char *e = Nullch;
if (!SvPOK(err))
sv_setpv(err,"");
else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
if (cxix >= 0) {
I32 optype;
+ register PERL_CONTEXT *cx;
if (cxix < cxstack_ix)
dounwind(cxix);
PL_curcop = cx->blk_oldcop;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(ERRSV, n_a);
- SV *nsv = cx->blk_eval.old_namesv;
- (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
+ const char* msg = SvPVx(ERRSV, n_a);
+ SV *nsv = cx->blk_eval.old_namesv;
+ (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
&PL_sv_undef, 0);
DIE(aTHX_ "%sCompilation failed in require",
*msg ? msg : "Unknown error\n");
PERL_SI *top_si = PL_curstackinfo;
I32 dbcxix;
I32 gimme;
- char *stashname;
+ const char *stashname;
SV *sv;
I32 count = 0;
}
RETURN;
}
- if (PL_DBsub && cxix >= 0 &&
+ /* caller() should not report the automatic calls to &DB::sub */
+ if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
count++;
if (!count--)
dbcxix = dopoptosub_at(ccstack, cxix - 1);
/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
field below is defined for any cx. */
- if (PL_DBsub && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
+ /* caller() should not report the automatic calls to &DB::sub */
+ if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
cx = &ccstack[dbcxix];
}
&& CopSTASH_eq(PL_curcop, PL_debstash))
{
AV *ary = cx->blk_sub.argarray;
- int off = AvARRAY(ary) - AvALLOC(ary);
+ const int off = AvARRAY(ary) - AvALLOC(ary);
if (!PL_dbargs) {
GV* tmpgv;
PP(pp_reset)
{
dSP;
- char *tmps;
+ const char *tmps;
STRLEN n_a;
if (MAXARG < 1)
PP(pp_dbstate)
{
+ dVAR;
PL_curcop = (COP*)PL_op;
TAINT_NOT; /* Each statement is presumed innocent */
PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
PP(pp_enteriter)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
SV **svp;
PP(pp_enterloop)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
PP(pp_leaveloop)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme;
SV **newsp;
PP(pp_return)
{
- dSP; dMARK;
+ dVAR; dSP; dMARK;
I32 cxix;
register PERL_CONTEXT *cx;
bool popsub2 = FALSE;
PP(pp_last)
{
- dSP;
+ dVAR; dSP;
I32 cxix;
register PERL_CONTEXT *cx;
I32 pop2 = 0;
PP(pp_next)
{
+ dVAR;
I32 cxix;
register PERL_CONTEXT *cx;
I32 inner;
PP(pp_redo)
{
+ dVAR;
I32 cxix;
register PERL_CONTEXT *cx;
I32 oldsave;
}
STATIC OP *
-S_dofindlabel(pTHX_ OP *o, char *label, OP **opstack, OP **oplimit)
+S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
{
OP *kid = Nullop;
OP **ops = opstack;
- static char too_deep[] = "Target of goto is too deeply nested";
+ static const char too_deep[] = "Target of goto is too deeply nested";
if (ops >= oplimit)
Perl_croak(aTHX_ too_deep);
PP(pp_goto)
{
- dSP;
+ dVAR; dSP;
OP *retop = 0;
I32 ix;
register PERL_CONTEXT *cx;
#define GOTO_DEPTH 64
OP *enterops[GOTO_DEPTH];
- char *label;
- int do_dump = (PL_op->op_type == OP_DUMP);
- static char must_have_label[] = "goto must have label";
- AV *oldav = Nullav;
+ const char *label = 0;
+ const bool do_dump = (PL_op->op_type == OP_DUMP);
+ static const char must_have_label[] = "goto must have label";
- label = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV *sv = POPs;
STRLEN n_a;
SV** mark;
I32 items = 0;
I32 oldsave;
+ bool reified = 0;
retry:
if (!CvROOT(cv) && !CvXSUB(cv)) {
- GV *gv = CvGV(cv);
- GV *autogv;
+ const GV * const gv = CvGV(cv);
if (gv) {
+ GV *autogv;
SV *tmpstr;
/* autoloaded stub? */
if (cv != GvCV(gv) && (cv = GvCV(gv)))
}
/* First do some returnish stuff. */
- SvREFCNT_inc(cv); /* avoid premature free during unwind */
+ (void)SvREFCNT_inc(cv); /* avoid premature free during unwind */
FREETMPS;
cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
/* put @_ back onto stack */
AV* av = cx->blk_sub.argarray;
-
+
items = AvFILLp(av) + 1;
EXTEND(SP, items+1); /* @_ could have been extended. */
Copy(AvARRAY(av), SP + 1, items, SV*);
SvREFCNT_dec(GvAV(PL_defgv));
GvAV(PL_defgv) = cx->blk_sub.savearray;
+ CLEAR_ARGARRAY(av);
/* abandon @_ if it got reified */
if (AvREAL(av)) {
- oldav = av; /* delay until return */
+ reified = 1;
+ SvREFCNT_dec(av);
av = newAV();
av_extend(av, items-1);
AvFLAGS(av) = AVf_REIFY;
PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
}
- else
- CLEAR_ARGARRAY(av);
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
AV* av;
/* Now do some callish stuff. */
SAVETMPS;
- /* For reified @_, delay freeing till return from new sub */
- if (oldav)
- SAVEFREESV((SV*)oldav);
SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
if (CvXSUB(cv)) {
+ if (reified) {
+ I32 index;
+ for (index=0; index<items; index++)
+ sv_2mortal(SP[-index]);
+ }
#ifdef PERL_XSUB_OLDSTYLE
if (CvOLDSTYLE(cv)) {
I32 (*fp3)(int,int,int);
else {
if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
sub_crush_depth(cv);
- pad_push(padlist, CvDEPTH(cv), 1);
+ pad_push(padlist, CvDEPTH(cv));
}
PAD_SET_CUR(padlist, CvDEPTH(cv));
if (cx->blk_sub.hasargs)
ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
if (items >= AvMAX(av) + 1) {
AvMAX(av) = items - 1;
Renew(ary,items+1,SV*);
AvALLOC(av) = ary;
- SvPVX(av) = (char*)ary;
+ SvPV_set(av, (char*)ary);
}
}
++mark;
Copy(mark,AvARRAY(av),items,SV*);
AvFILLp(av) = items - 1;
assert(!AvREAL(av));
+ if (reified) {
+ /* transfer 'ownership' of refcnts to new @_ */
+ AvREAL_on(av);
+ AvREIFY_off(av);
+ }
while (items--) {
if (*mark)
SvTEMP_off(*mark);
*/
SV *sv = GvSV(PL_DBsub);
CV *gotocv;
-
+
+ save_item(sv);
if (PERLDB_SUB_NN) {
- (void)SvUPGRADE(sv, SVt_PVIV);
+ int type = SvTYPE(sv);
+ if (type < SVt_PVIV && type != SVt_IV)
+ sv_upgrade(sv, SVt_PVIV);
(void)SvIOK_on(sv);
- SAVEIV(SvIVX(sv));
- SvIVX(sv) = PTR2IV(cv); /* Do it the quickest way */
+ SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
} else {
- save_item(sv);
gv_efullname3(sv, CvGV(cv), Nullch);
}
if ( PERLDB_GOTO
STATIC void
S_save_lines(pTHX_ AV *array, SV *sv)
{
- register char *s = SvPVX(sv);
- register char *send = SvPVX(sv) + SvCUR(sv);
- register char *t;
+ register const char *s = SvPVX(sv);
+ register const char *send = SvPVX(sv) + SvCUR(sv);
+ register const char *t;
register I32 line = 1;
while (s && s < send) {
}
}
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
-STATIC void *
-S_docatch_body(pTHX_ va_list args)
-{
- return docatch_body();
-}
-#endif
-
STATIC void *
S_docatch_body(pTHX)
{
S_docatch(pTHX_ OP *o)
{
int ret;
- OP *oldop = PL_op;
- OP *retop;
- volatile PERL_SI *cursi = PL_curstackinfo;
+ OP * const oldop = PL_op;
dJMPENV;
#ifdef DEBUGGING
#endif
PL_op = o;
- /* Normally, the leavetry at the end of this block of ops will
- * pop an op off the return stack and continue there. By setting
- * the op to Nullop, we force an exit from the inner runops()
- * loop. DAPM.
- */
- assert(cxstack_ix >= 0);
- assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
- retop = cxstack[cxstack_ix].blk_eval.retop;
- cxstack[cxstack_ix].blk_eval.retop = Nullop;
-
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
- redo_body:
- CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
-#else
JMPENV_PUSH(ret);
-#endif
switch (ret) {
case 0:
-#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ assert(cxstack_ix >= 0);
+ assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
+ cxstack[cxstack_ix].blk_eval.cur_top_env = PL_top_env;
redo_body:
docatch_body();
-#endif
break;
case 3:
/* die caught by an inner eval - continue inner loop */
- if (PL_restartop && cursi == PL_curstackinfo) {
+
+ /* NB XXX we rely on the old popped CxEVAL still being at the top
+ * of the stack; the way die_where() currently works, this
+ * assumption is valid. In theory The cur_top_env value should be
+ * returned in another global, the way retop (aka PL_restartop)
+ * is. */
+ assert(CxTYPE(&cxstack[cxstack_ix+1]) == CXt_EVAL);
+
+ if (PL_restartop
+ && cxstack[cxstack_ix+1].blk_eval.cur_top_env == PL_top_env)
+ {
PL_op = PL_restartop;
PL_restartop = 0;
goto redo_body;
}
- /* a die in this eval - continue in outer loop */
- if (!PL_restartop)
- break;
/* FALL THROUGH */
default:
JMPENV_POP;
}
JMPENV_POP;
PL_op = oldop;
- return retop;
+ return Nullop;
}
OP *
-Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, PAD** padp)
+Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
/* sv Text to convert to OP tree. */
/* startop op_free() this to undo. */
/* code Short string id of the caller. */
{
- dSP; /* Make POPBLOCK work. */
+ dVAR; dSP; /* Make POPBLOCK work. */
PERL_CONTEXT *cx;
SV **newsp;
I32 gimme = 0; /* SUSPECT - INITIALZE TO WHAT? NI-S */
CV*
Perl_find_runcv(pTHX_ U32 *db_seqp)
{
- I32 ix;
PERL_SI *si;
- PERL_CONTEXT *cx;
if (db_seqp)
*db_seqp = PL_curcop->cop_seq;
for (si = PL_curstackinfo; si; si = si->si_prev) {
+ I32 ix;
for (ix = si->si_cxix; ix >= 0; ix--) {
- cx = &(si->si_cxstack[ix]);
+ const PERL_CONTEXT *cx = &(si->si_cxstack[ix]);
if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
CV *cv = cx->blk_sub.cv;
/* skip DB:: code */
STATIC OP *
S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
{
- dSP;
+ dVAR; dSP;
OP *saveop = PL_op;
PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
PERL_CONTEXT *cx = &cxstack[cxstack_ix];
I32 optype = 0; /* Might be reset by POPEVAL. */
STRLEN n_a;
-
+
PL_op = saveop;
if (PL_eval_root) {
op_free(PL_eval_root);
lex_end();
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(ERRSV, n_a);
+ const char* msg = SvPVx(ERRSV, n_a);
SV *nsv = cx->blk_eval.old_namesv;
(void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
&PL_sv_undef, 0);
*msg ? msg : "Unknown error\n");
}
else if (startop) {
- char* msg = SvPVx(ERRSV, n_a);
+ const char* msg = SvPVx(ERRSV, n_a);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
(*msg ? msg : "Unknown error\n"));
}
else {
- char* msg = SvPVx(ERRSV, n_a);
+ const char* msg = SvPVx(ERRSV, n_a);
if (!*msg) {
sv_setpv(ERRSV, "Compilation error");
}
if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
SV *pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
- char *pmc = SvPV_nolen(pmcsv);
+ const char * const pmc = SvPV_nolen(pmcsv);
Stat_t pmstat;
Stat_t pmcstat;
if (PerlLIO_stat(pmc, &pmcstat) < 0) {
PP(pp_require)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
SV *sv;
char *name;
if (!sv_derived_from(PL_patchlevel, "version"))
(void *)upg_version(PL_patchlevel);
if ( vcmp(sv,PL_patchlevel) > 0 )
- DIE(aTHX_ "Perl v%_ required--this is only v%_, stopped",
+ DIE(aTHX_ "Perl v%"SVf" required--this is only v%"SVf", stopped",
vstringify(sv), vstringify(PL_patchlevel));
RETPUSHYES;
MacPerl_CanonDir(name, buf2, 1);
Perl_sv_setpvf(aTHX_ namesv, "%s%s", MacPerl_CanonDir(dir, buf1, 0), buf2+(buf2[0] == ':'));
#else
-#ifdef VMS
+# ifdef VMS
char *unixdir;
if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
continue;
sv_setpv(namesv, unixdir);
sv_catpv(namesv, unixname);
-#else
+# else
+# ifdef SYMBIAN
+ if (PL_origfilename[0] &&
+ PL_origfilename[1] == ':' &&
+ !(dir[0] && dir[1] == ':'))
+ Perl_sv_setpvf(aTHX_ namesv,
+ "%c:%s\\%s",
+ PL_origfilename[0],
+ dir, name);
+ else
+ Perl_sv_setpvf(aTHX_ namesv,
+ "%s\\%s",
+ dir, name);
+# else
Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name);
-#endif
+# endif
+# endif
#endif
TAINT_PROPER("require");
tryname = SvPVX(namesv);
PL_encoding = Nullsv;
op = DOCATCH(doeval(gimme, NULL, Nullcv, PL_curcop->cop_seq));
-
+
/* Restore encoding. */
PL_encoding = encoding;
PP(pp_entereval)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
dPOPss;
I32 gimme = GIMME_V, was = PL_sub_generation;
PP(pp_leaveeval)
{
- dSP;
+ dVAR; dSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
I32 gimme;
register PERL_CONTEXT *cx;
OP *retop;
- U8 save_flags = PL_op -> op_flags;
+ const U8 save_flags = PL_op -> op_flags;
I32 optype;
POPBLOCK(cx,newpm);
PP(pp_entertry)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = GIMME_V;
PP(pp_leavetry)
{
- dSP;
+ dVAR; dSP;
register SV **mark;
SV **newsp;
PMOP *newpm;
- OP* retop;
I32 gimme;
register PERL_CONTEXT *cx;
I32 optype;
POPBLOCK(cx,newpm);
POPEVAL(cx);
- retop = cx->blk_eval.retop;
TAINT_NOT;
if (gimme == G_VOID)
LEAVE;
sv_setpv(ERRSV,"");
- RETURNOP(retop);
+ RETURN;
}
STATIC OP *
while (*s == '#')
s++;
if (*s == '.') {
- char *f;
- s++;
- f = s;
+ const char * const f = ++s;
while (*s == '#')
s++;
arg |= 256 + (s - f);
while (*s == '#')
s++;
if (*s == '.') {
- char *f;
- s++;
- f = s;
+ const char * const f = ++s;
while (*s == '#')
s++;
arg |= 256 + (s - f);
sv_magic(sv, Nullsv, PERL_MAGIC_fm, Nullch, 0);
SvCOMPILED_on(sv);
- if (unchopnum && repeat)
+ if (unchopnum && repeat)
DIE(aTHX_ "Repeated format line will never terminate (~~ and @#)");
return 0;
}
static I32
run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
{
+ dVAR;
SV *datasv = FILTER_DATA(idx);
int filter_has_file = IoLINES(datasv);
GV *filter_child_proc = (GV *)IoFMT_GV(datasv);
/* perhaps someone can come up with a better name for
this? it is not really "absolute", per se ... */
static bool
-S_path_is_absolute(pTHX_ char *name)
+S_path_is_absolute(pTHX_ const char *name)
{
if (PERL_FILE_IS_ABSOLUTE(name)
#ifdef MACOS_TRADITIONAL
else
return FALSE;
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * vim: shiftwidth=4:
+*/
https://perl5.git.perl.org / perl5.git / blobdiff