/* pp_ctl.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 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.
PP(pp_wantarray)
{
+ dVAR;
dSP;
I32 cxix;
EXTEND(SP, 1);
PP(pp_regcreset)
{
+ dVAR;
/* XXXX Should store the old value to allow for tie/overload - and
restore in regcomp, where marked with XXXX. */
PL_reginterp_cnt = 0;
PP(pp_regcomp)
{
+ dVAR;
dSP;
register PMOP *pm = (PMOP*)cLOGOP->op_other;
SV *tmpstr;
PP(pp_substcont)
{
+ dVAR;
dSP;
register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
register PMOP * const pm = (PMOP*) cLOGOP->op_other;
SvLEN_set(targ, SvLEN(dstr));
if (DO_UTF8(dstr))
SvUTF8_on(targ);
- SvPV_set(dstr, (char*)0);
+ SvPV_set(dstr, NULL);
sv_free(dstr);
TAINT_IF(cx->sb_rxtainted & 1);
PP(pp_formline)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register SV * const tmpForm = *++MARK;
register U32 *fpc;
register char *t;
bool item_is_utf8 = FALSE;
bool targ_is_utf8 = FALSE;
SV * nsv = NULL;
- OP * parseres = 0;
+ OP * parseres = NULL;
const char *fmt;
bool oneline;
PP(pp_range)
{
+ dVAR;
if (GIMME == G_ARRAY)
return NORMAL;
if (SvTRUEx(PAD_SV(PL_op->op_targ)))
PP(pp_flip)
{
+ dVAR;
dSP;
if (GIMME == G_ARRAY) {
flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
}
else {
- GV * const gv = gv_fetchpv(".", TRUE, SVt_PV);
+ GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV);
if (gv && GvSV(gv))
flip = SvIV(sv) == SvIV(GvSV(gv));
}
PP(pp_flop)
{
- dSP;
+ dVAR; dSP;
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
}
else {
- GV * const gv = gv_fetchpv(".", TRUE, SVt_PV);
+ GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV);
if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv));
}
}
if (flop) {
sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0);
- sv_catpvn(targ, "E0", 2);
+ sv_catpvs(targ, "E0");
}
SETs(targ);
}
STATIC I32
S_dopoptolabel(pTHX_ const char *label)
{
+ dVAR;
register I32 i;
for (i = cxstack_ix; i >= 0; i--) {
I32
Perl_dowantarray(pTHX)
{
+ dVAR;
const I32 gimme = block_gimme();
return (gimme == G_VOID) ? G_SCALAR : gimme;
}
I32
Perl_block_gimme(pTHX)
{
+ dVAR;
const I32 cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
return G_VOID;
I32
Perl_is_lvalue_sub(pTHX)
{
+ dVAR;
const I32 cxix = dopoptosub(cxstack_ix);
assert(cxix >= 0); /* We should only be called from inside subs */
STATIC I32
S_dopoptosub(pTHX_ I32 startingblock)
{
+ dVAR;
return dopoptosub_at(cxstack, startingblock);
}
STATIC I32
S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT * const cx = &cxstk[i];
STATIC I32
S_dopoptoeval(pTHX_ I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT *cx = &cxstack[i];
STATIC I32
S_dopoptoloop(pTHX_ I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT * const cx = &cxstack[i];
STATIC I32
S_dopoptogiven(pTHX_ I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT *cx = &cxstack[i];
STATIC I32
S_dopoptowhen(pTHX_ I32 startingblock)
{
+ dVAR;
I32 i;
for (i = startingblock; i >= 0; i--) {
register const PERL_CONTEXT *cx = &cxstack[i];
void
Perl_dounwind(pTHX_ I32 cxix)
{
+ dVAR;
I32 optype;
while (cxstack_ix > cxix) {
void
Perl_qerror(pTHX_ SV *err)
{
+ dVAR;
if (PL_in_eval)
sv_catsv(ERRSV, err);
else if (PL_errors)
PP(pp_xor)
{
- dSP; dPOPTOPssrl;
+ dVAR; dSP; dPOPTOPssrl;
if (SvTRUE(left) != SvTRUE(right))
RETSETYES;
else
PP(pp_caller)
{
+ dVAR;
dSP;
register I32 cxix = dopoptosub(cxstack_ix);
register const PERL_CONTEXT *cx;
GV * const cvgv = CvGV(ccstack[cxix].blk_sub.cv);
/* So is ccstack[dbcxix]. */
if (isGV(cvgv)) {
- SV * const sv = NEWSV(49, 0);
+ SV * const sv = newSV(0);
gv_efullname3(sv, cvgv, NULL);
PUSHs(sv_2mortal(sv));
PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
}
else {
- PUSHs(sv_2mortal(newSVpvn("(unknown)",9)));
+ PUSHs(sv_2mortal(newSVpvs("(unknown)")));
PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
}
}
else {
- PUSHs(sv_2mortal(newSVpvn("(eval)",6)));
+ PUSHs(sv_2mortal(newSVpvs("(eval)")));
PUSHs(sv_2mortal(newSViv(0)));
}
gimme = (I32)cx->blk_gimme;
const int off = AvARRAY(ary) - AvALLOC(ary);
if (!PL_dbargs) {
- GV* const tmpgv = gv_fetchpv("DB::args", TRUE, SVt_PVAV);
+ GV* const tmpgv = gv_fetchpvs("DB::args", GV_ADD, SVt_PVAV);
PL_dbargs = GvAV(gv_AVadd(tmpgv));
GvMULTI_on(tmpgv);
AvREAL_off(PL_dbargs); /* XXX should be REIFY (see av.h) */
* it could have been extended by warnings::register */
SV **bits_all;
HV * const bits = get_hv("warnings::Bits", FALSE);
- if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
+ if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
mask = newSVsv(*bits_all);
}
else {
PP(pp_reset)
{
+ dVAR;
dSP;
const char * const tmps = (MAXARG < 1) ? "" : POPpconstx;
sv_reset(tmps, CopSTASH(PL_curcop));
GV * const gv = (GV*)POPs;
svp = &GvSV(gv); /* symbol table variable */
SAVEGENERICSV(*svp);
- *svp = NEWSV(0,0);
+ *svp = newSV(0);
#ifdef USE_ITHREADS
iterdata = (void*)gv;
#endif
STATIC OP *
S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
{
+ dVAR;
OP **ops = opstack;
static const char too_deep[] = "Target of goto is too deeply nested";
PP(pp_goto)
{
dVAR; dSP;
- OP *retop = 0;
+ OP *retop = NULL;
I32 ix;
register PERL_CONTEXT *cx;
#define GOTO_DEPTH 64
OP *enterops[GOTO_DEPTH];
- const char *label = 0;
+ const char *label = NULL;
const bool do_dump = (PL_op->op_type == OP_DUMP);
static const char must_have_label[] = "goto must have label";
label = cPVOP->op_pv;
if (label && *label) {
- OP *gotoprobe = 0;
+ OP *gotoprobe = NULL;
bool leaving_eval = FALSE;
bool in_block = FALSE;
- PERL_CONTEXT *last_eval_cx = 0;
+ PERL_CONTEXT *last_eval_cx = NULL;
/* find label */
PP(pp_exit)
{
+ dVAR;
dSP;
I32 anum;
RETURN;
}
-#ifdef NOTYET
-PP(pp_nswitch)
-{
- dSP;
- const NV value = SvNVx(GvSV(cCOP->cop_gv));
- register I32 match = I_32(value);
-
- if (value < 0.0) {
- if (((NV)match) > value)
- --match; /* was fractional--truncate other way */
- }
- match -= cCOP->uop.scop.scop_offset;
- if (match < 0)
- match = 0;
- else if (match > cCOP->uop.scop.scop_max)
- match = cCOP->uop.scop.scop_max;
- PL_op = cCOP->uop.scop.scop_next[match];
- RETURNOP(PL_op);
-}
-
-PP(pp_cswitch)
-{
- dSP;
- register I32 match;
-
- if (PL_multiline)
- PL_op = PL_op->op_next; /* can't assume anything */
- else {
- match = *(SvPVx_nolen_const(GvSV(cCOP->cop_gv))) & 255;
- match -= cCOP->uop.scop.scop_offset;
- if (match < 0)
- match = 0;
- else if (match > cCOP->uop.scop.scop_max)
- match = cCOP->uop.scop.scop_max;
- PL_op = cCOP->uop.scop.scop_next[match];
- }
- RETURNOP(PL_op);
-}
-#endif
-
/* Eval. */
STATIC void
while (s && s < send) {
const char *t;
- SV * const tmpstr = NEWSV(85,0);
+ SV * const tmpstr = newSV(0);
sv_upgrade(tmpstr, SVt_PVMG);
t = strchr(s, '\n');
STATIC void
S_docatch_body(pTHX)
{
+ dVAR;
CALLRUNOPS(aTHX);
return;
}
STATIC OP *
S_docatch(pTHX_ OP *o)
{
+ dVAR;
int ret;
OP * const oldop = PL_op;
dJMPENV;
char *tmpbuf = tbuf;
char *safestr;
int runtime;
- CV* runcv = Nullcv; /* initialise to avoid compiler warnings */
+ CV* runcv = NULL; /* initialise to avoid compiler warnings */
STRLEN len;
ENTER;
PL_op->op_type = OP_ENTEREVAL;
PL_op->op_flags = 0; /* Avoid uninit warning. */
PUSHBLOCK(cx, CXt_EVAL|(IN_PERL_COMPILETIME ? 0 : CXp_REAL), SP);
- PUSHEVAL(cx, 0, Nullgv);
+ PUSHEVAL(cx, 0, NULL);
if (runtime)
rop = doeval(G_SCALAR, startop, runcv, PL_curcop->cop_seq);
CV*
Perl_find_runcv(pTHX_ U32 *db_seqp)
{
+ dVAR;
PERL_SI *si;
if (db_seqp)
PUSHMARK(SP);
SAVESPTR(PL_compcv);
- PL_compcv = (CV*)NEWSV(1104,0);
+ PL_compcv = (CV*)newSV(0);
sv_upgrade((SV *)PL_compcv, SVt_PVCV);
CvEVAL_on(PL_compcv);
assert(CxTYPE(&cxstack[cxstack_ix]) == CXt_EVAL);
PL_error_count = 0;
PL_curcop = &PL_compiling;
PL_curcop->cop_arybase = 0;
- if (saveop && saveop->op_flags & OPf_SPECIAL)
+ if (saveop && saveop->op_type != OP_REQUIRE && saveop->op_flags & OPf_SPECIAL)
PL_in_eval |= EVAL_KEEPERR;
else
sv_setpvn(ERRSV,"",0);
sv = new_version(sv);
if (!sv_derived_from(PL_patchlevel, "version"))
- (void *)upg_version(PL_patchlevel);
+ upg_version(PL_patchlevel);
if (cUNOP->op_first->op_type == OP_CONST && cUNOP->op_first->op_private & OPpCONST_NOVER) {
if ( vcmp(sv,PL_patchlevel) < 0 )
DIE(aTHX_ "Perls since %"SVf" too modern--this is %"SVf", stopped",
if ((unixname = tounixspec(name, NULL)) != NULL)
#endif
{
- namesv = NEWSV(806, 0);
+ namesv = newSV(0);
for (i = 0; i <= AvFILL(ar); i++) {
SV *dirsv = *av_fetch(ar, i, TRUE);
if (PL_op->op_type == OP_REQUIRE) {
const char *msgstr = name;
if(errno == EMFILE) {
- SV * const msg = sv_2mortal(newSVpv(msgstr,0));
- sv_catpv(msg, ": ");
- sv_catpv(msg, Strerror(errno));
+ SV * const msg
+ = sv_2mortal(Perl_newSVpvf(aTHX_ "%s: %s", msgstr,
+ Strerror(errno)));
msgstr = SvPV_nolen_const(msg);
} else {
if (namesv) { /* did we lookup @INC? */
- SV * const msg = sv_2mortal(newSVpv(msgstr,0));
- SV * const dirmsgsv = NEWSV(0, 0);
AV * const ar = GvAVn(PL_incgv);
I32 i;
- sv_catpvn(msg, " in @INC", 8);
- if (instr(SvPVX_const(msg), ".h "))
- sv_catpv(msg, " (change .h to .ph maybe?)");
- if (instr(SvPVX_const(msg), ".ph "))
- sv_catpv(msg, " (did you run h2ph?)");
- sv_catpv(msg, " (@INC contains:");
+ SV * const msg = sv_2mortal(Perl_newSVpvf(aTHX_
+ "%s in @INC%s%s (@INC contains:",
+ msgstr,
+ (instr(msgstr, ".h ")
+ ? " (change .h to .ph maybe?)" : ""),
+ (instr(msgstr, ".ph ")
+ ? " (did you run h2ph?)" : "")
+ ));
+
for (i = 0; i <= AvFILL(ar); i++) {
- const char *dir = SvPVx_nolen_const(*av_fetch(ar, i, TRUE));
- Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
- sv_catsv(msg, dirmsgsv);
+ sv_catpvs(msg, " ");
+ sv_catsv(msg, *av_fetch(ar, i, TRUE));
}
- sv_catpvn(msg, ")", 1);
- SvREFCNT_dec(dirmsgsv);
+ sv_catpvs(msg, ")");
msgstr = SvPV_nolen_const(msg);
}
}
ENTER;
SAVETMPS;
- lex_start(sv_2mortal(newSVpvn("",0)));
+ lex_start(sv_2mortal(newSVpvs("")));
SAVEGENERICSV(PL_rsfp_filters);
PL_rsfp_filters = NULL;
/* switch to eval mode */
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, name, Nullgv);
+ PUSHEVAL(cx, name, NULL);
cx->blk_eval.retop = PL_op->op_next;
SAVECOPLINE(&PL_compiling);
encoding = PL_encoding;
PL_encoding = NULL;
- op = DOCATCH(doeval(gimme, NULL, Nullcv, PL_curcop->cop_seq));
+ op = DOCATCH(doeval(gimme, NULL, NULL, PL_curcop->cop_seq));
/* Restore encoding. */
PL_encoding = encoding;
runcv = find_runcv(&seq);
PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
- PUSHEVAL(cx, 0, Nullgv);
+ PUSHEVAL(cx, 0, NULL);
cx->blk_eval.retop = PL_op->op_next;
/* prepare to compile string */
PMOP *
S_make_matcher(pTHX_ regexp *re)
{
+ dVAR;
PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
PM_SETRE(matcher, ReREFCNT_inc(re));
bool
S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
{
+ dVAR;
dSP;
PL_op = (OP *) matcher;
void
S_destroy_matcher(pTHX_ PMOP *matcher)
{
+ dVAR;
PERL_UNUSED_ARG(matcher);
FREETMPS;
LEAVE;
/* Do a smart match */
PP(pp_smartmatch)
{
- return do_smartmatch(Nullhv, Nullhv);
+ return do_smartmatch(NULL, NULL);
}
/* This version of do_smartmatch() implements the following
OP *
S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
{
+ dVAR;
dSP;
SV *e = TOPs; /* e is for 'expression' */
I32 i;
const I32 other_len = av_len(other_av);
- if (Nullhv == seen_this) {
+ if (NULL == seen_this) {
seen_this = newHV();
(void) sv_2mortal((SV *) seen_this);
}
- if (Nullhv == seen_other) {
+ if (NULL == seen_other) {
seen_this = newHV();
(void) sv_2mortal((SV *) seen_other);
}
bool postspace = FALSE;
U32 *fops;
register U32 *fpc;
- U32 *linepc = 0;
+ U32 *linepc = NULL;
register I32 arg;
bool ischop;
bool unchopnum = FALSE;
IoLINES(datasv) = 0;
if (filter_child_proc) {
SvREFCNT_dec(filter_child_proc);
- IoFMT_GV(datasv) = Nullgv;
+ IoFMT_GV(datasv) = NULL;
}
if (filter_state) {
SvREFCNT_dec(filter_state);
- IoTOP_GV(datasv) = Nullgv;
+ IoTOP_GV(datasv) = NULL;
}
if (filter_sub) {
SvREFCNT_dec(filter_sub);
- IoBOTTOM_GV(datasv) = Nullgv;
+ IoBOTTOM_GV(datasv) = NULL;
}
filter_del(S_run_user_filter);
}