/* 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;
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
TAINT_NOT;
if (gimme == G_VOID)
- ; /* do nothing */
+ /*EMPTY*/; /* do nothing */
else if (gimme == G_SCALAR) {
if (mark < SP)
*++newsp = sv_mortalcopy(*SP);
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_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;
}
JMPENV_POP;
PL_op = oldop;
- return Nullop;
+ return NULL;
}
OP *
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);
/* try to compile it */
- PL_eval_root = Nullop;
+ PL_eval_root = NULL;
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);
PL_op = saveop;
if (PL_eval_root) {
op_free(PL_eval_root);
- PL_eval_root = Nullop;
+ PL_eval_root = NULL;
}
SP = PL_stack_base + POPMARK; /* pop original mark */
if (!startop) {
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);
));
for (i = 0; i <= AvFILL(ar); i++) {
- sv_catpvn(msg, " ", 1);
+ sv_catpvs(msg, " ");
sv_catsv(msg, *av_fetch(ar, i, TRUE));
}
- sv_catpvn(msg, ")", 1);
+ 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;
/* switch to eval mode */
if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
- SV * const sv = sv_newmortal();
- Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]",
+ SV * const temp_sv = sv_newmortal();
+ Perl_sv_setpvf(aTHX_ temp_sv, "_<(eval %lu)[%s:%"IVdf"]",
(unsigned long)++PL_evalseq,
CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
- tmpbuf = SvPVX(sv);
- len = SvCUR(sv);
+ tmpbuf = SvPVX(temp_sv);
+ len = SvCUR(temp_sv);
}
else
len = my_sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
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);
}
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);
}
/* 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_ const char *name)
+S_path_is_absolute(const char *name)
{
if (PERL_FILE_IS_ABSOLUTE(name)
#ifdef MACOS_TRADITIONAL
projects / p5sagit/p5-mst-13.2.git / blobdiff