/* 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;
- MAGIC *mg = Null(MAGIC*);
+ MAGIC *mg = NULL;
/* prevent recompiling under /o and ithreads. */
#if defined(USE_ITHREADS)
{
if (PM_GETRE(pm)) {
ReREFCNT_dec(PM_GETRE(pm));
- PM_SETRE(pm, Null(REGEXP*)); /* crucial if regcomp aborts */
+ PM_SETRE(pm, NULL); /* crucial if regcomp aborts */
}
if (PL_op->op_flags & OPf_SPECIAL)
PL_reginterp_cnt = I32_MAX; /* Mark as safe. */
PP(pp_substcont)
{
+ dVAR;
dSP;
register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
register PMOP * const pm = (PMOP*) cLOGOP->op_other;
register char *m = cx->sb_m;
char *orig = cx->sb_orig;
register REGEXP * const rx = cx->sb_rx;
- SV *nsv = Nullsv;
+ SV *nsv = NULL;
REGEXP *old = PM_GETRE(pm);
if(old != rx) {
if(old)
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);
if (SvTYPE(sv) < SVt_PVMG)
SvUPGRADE(sv, SVt_PVMG);
if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
- sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
+ sv_magic(sv, NULL, PERL_MAGIC_regex_global, NULL, 0);
mg = mg_find(sv, PERL_MAGIC_regex_global);
}
i = m - orig;
{
UV *p = (UV*)*rsp;
U32 i;
+ PERL_UNUSED_CONTEXT;
if (!p || p[1] < rx->nparens) {
#ifdef PERL_OLD_COPY_ON_WRITE
*rsp = (void*)p;
}
- *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
+ *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : NULL);
RX_MATCH_COPIED_off(rx);
#ifdef PERL_OLD_COPY_ON_WRITE
*p++ = PTR2UV(rx->saved_copy);
- rx->saved_copy = Nullsv;
+ rx->saved_copy = NULL;
#endif
*p++ = rx->nparens;
{
UV *p = (UV*)*rsp;
U32 i;
+ PERL_UNUSED_CONTEXT;
RX_MATCH_COPY_FREE(rx);
RX_MATCH_COPIED_set(rx, *p);
Perl_rxres_free(pTHX_ void **rsp)
{
UV * const p = (UV*)*rsp;
+ PERL_UNUSED_CONTEXT;
if (p) {
#ifdef PERL_POISON
}
#endif
Safefree(p);
- *rsp = Null(void*);
+ *rsp = NULL;
}
}
PP(pp_formline)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
register SV * const tmpForm = *++MARK;
register U32 *fpc;
register char *t;
const char *f;
register I32 arg;
- register SV *sv = Nullsv;
- const char *item = Nullch;
+ register SV *sv = NULL;
+ const char *item = NULL;
I32 itemsize = 0;
I32 fieldsize = 0;
I32 lines = 0;
- bool chopspace = (strchr(PL_chopset, ' ') != Nullch);
- const char *chophere = Nullch;
- char *linemark = Nullch;
+ bool chopspace = (strchr(PL_chopset, ' ') != NULL);
+ const char *chophere = NULL;
+ char *linemark = NULL;
NV value;
bool gotsome = FALSE;
STRLEN len;
? (SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1) : 0;
bool item_is_utf8 = FALSE;
bool targ_is_utf8 = FALSE;
- SV * nsv = Nullsv;
- OP * parseres = 0;
+ SV * nsv = NULL;
+ 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)
if (PL_in_eval & EVAL_KEEPERR) {
static const char prefix[] = "\t(in cleanup) ";
SV * const err = ERRSV;
- const char *e = Nullch;
+ const char *e = NULL;
if (!SvPOK(err))
sv_setpvn(err,"",0);
else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
e = SvPV_const(err, len);
e += len - msglen;
if (*e != *message || strNE(e,message))
- e = Nullch;
+ e = NULL;
}
if (!e) {
SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
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);
- gv_efullname3(sv, cvgv, Nullch);
+ 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));
hasargs = 0;
SPAGAIN;
- if (CvXSUB(cv)) {
+ if (CvISXSUB(cv)) {
CvDEPTH(cv)++;
PUSHMARK(SP);
(void)(*CvXSUB(cv))(aTHX_ cv);
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);
POPSUB(cx,sv); /* release CV and @_ ... */
}
else
- sv = Nullsv;
+ sv = NULL;
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVESUB(sv);
SV **newsp;
PMOP *newpm;
SV **mark;
- SV *sv = Nullsv;
+ SV *sv = NULL;
if (PL_op->op_flags & OPf_SPECIAL) {
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";
if (autogv && (cv = GvCV(autogv)))
goto retry;
tmpstr = sv_newmortal();
- gv_efullname3(tmpstr, gv, Nullch);
+ gv_efullname3(tmpstr, gv, NULL);
DIE(aTHX_ "Goto undefined subroutine &%"SVf"",tmpstr);
}
DIE(aTHX_ "Goto undefined subroutine");
}
/* First do some returnish stuff. */
- (void)SvREFCNT_inc(cv); /* avoid premature free during unwind */
+ SvREFCNT_inc_simple_void(cv); /* avoid premature free during unwind */
FREETMPS;
cxix = dopoptosub(cxstack_ix);
if (cxix < 0)
PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
}
}
- else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
+ else if (CvISXSUB(cv)) { /* put GvAV(defgv) back onto stack */
AV* const av = GvAV(PL_defgv);
items = AvFILLp(av) + 1;
EXTEND(SP, items+1); /* @_ could have been extended. */
/* Now do some callish stuff. */
SAVETMPS;
SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
- if (CvXSUB(cv)) {
- OP* retop = cx->blk_sub.retop;
+ if (CvISXSUB(cv)) {
+ OP* const retop = cx->blk_sub.retop;
+ SV **newsp;
+ I32 gimme;
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);
- while (SP > mark) {
- SP[1] = SP[0];
- SP--;
- }
- fp3 = (I32(*)(int,int,int))CvXSUB(cv);
- items = (*fp3)(CvXSUBANY(cv).any_i32,
- mark - PL_stack_base + 1,
- items);
- SP = PL_stack_base + items;
- }
- else
-#endif /* PERL_XSUB_OLDSTYLE */
- {
- SV **newsp;
- I32 gimme;
- /* XS subs don't have a CxSUB, so pop it */
- POPBLOCK(cx, PL_curpm);
- /* Push a mark for the start of arglist */
- PUSHMARK(mark);
- PUTBACK;
- (void)(*CvXSUB(cv))(aTHX_ cv);
- /* Put these at the bottom since the vars are set but not used */
- PERL_UNUSED_VAR(newsp);
- PERL_UNUSED_VAR(gimme);
- }
+ /* XS subs don't have a CxSUB, so pop it */
+ POPBLOCK(cx, PL_curpm);
+ /* Push a mark for the start of arglist */
+ PUSHMARK(mark);
+ PUTBACK;
+ (void)(*CvXSUB(cv))(aTHX_ cv);
LEAVE;
return retop;
}
else {
- AV* padlist = CvPADLIST(cv);
+ AV* const padlist = CvPADLIST(cv);
if (CxTYPE(cx) == CXt_EVAL) {
PL_in_eval = cx->blk_eval.old_in_eval;
PL_eval_root = cx->blk_eval.old_eval_root;
cx->blk_sub.hasargs = 0;
}
cx->blk_sub.cv = cv;
- cx->blk_sub.olddepth = (U16)CvDEPTH(cv);
+ cx->blk_sub.olddepth = CvDEPTH(cv);
CvDEPTH(cv)++;
if (CvDEPTH(cv) < 2)
- (void)SvREFCNT_inc(cv);
+ SvREFCNT_inc_void_NN(cv);
else {
if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
sub_crush_depth(cv);
PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
if (cx->blk_sub.hasargs)
{
- AV* av = (AV*)PAD_SVl(0);
- SV** ary;
+ AV* const av = (AV*)PAD_SVl(0);
cx->blk_sub.savearray = GvAV(PL_defgv);
- GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
+ GvAV(PL_defgv) = (AV*)SvREFCNT_inc_simple(av);
CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
if (items >= AvMAX(av) + 1) {
- ary = AvALLOC(av);
+ SV **ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
SvPV_set(av, (char*)ary);
* it's for informational purposes only.
*/
SV * const sv = GvSV(PL_DBsub);
- CV *gotocv;
-
save_item(sv);
if (PERLDB_SUB_NN) {
const int type = SvTYPE(sv);
(void)SvIOK_on(sv);
SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
} else {
- gv_efullname3(sv, CvGV(cv), Nullch);
+ gv_efullname3(sv, CvGV(cv), NULL);
}
- if ( PERLDB_GOTO
- && (gotocv = get_cv("DB::goto", FALSE)) ) {
- PUSHMARK( PL_stack_sp );
- call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
- PL_stack_sp--;
+ if (PERLDB_GOTO) {
+ CV * const gotocv = get_cv("DB::goto", FALSE);
+ if (gotocv) {
+ PUSHMARK( PL_stack_sp );
+ call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
+ PL_stack_sp--;
+ }
}
}
RETURNOP(CvSTART(cv));
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;
#endif
}
PL_exit_flags |= PERL_EXIT_EXPECTED;
+#ifdef PERL_MAD
+ /* KLUDGE: disable exit 0 in BEGIN blocks when we're just compiling */
+ if (anum || !(PL_minus_c && PL_madskills))
+ my_exit(anum);
+#else
my_exit(anum);
+#endif
PUSHs(&PL_sv_undef);
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);
(*startop)->op_ppaddr = PL_ppaddr[OP_NULL];
lex_end();
/* XXX DAPM do this properly one year */
- *padp = (AV*)SvREFCNT_inc(PL_comppad);
+ *padp = (AV*)SvREFCNT_inc_simple(PL_comppad);
LEAVE;
if (IN_PERL_COMPILETIME)
PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
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);
cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
CvOUTSIDE_SEQ(PL_compcv) = seq;
- CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outside);
+ CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc_simple(outside);
/* set up a scratch pad */
CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
- SAVEMORTALIZESV(PL_compcv); /* must remain until end of current statement */
+ if (!PL_madskills)
+ SAVEMORTALIZESV(PL_compcv); /* must remain until end of current statement */
/* make sure we compile in the right package */
SAVEFREESV(PL_beginav);
SAVEI32(PL_error_count);
+#ifdef PERL_MAD
+ SAVEI32(PL_madskills);
+ PL_madskills = 0;
+#endif
+
/* 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) {
S_check_type_and_open(pTHX_ const char *name, const char *mode)
{
Stat_t st;
- int st_rc;
- st_rc = PerlLIO_stat(name, &st);
+ const int st_rc = PerlLIO_stat(name, &st);
if (st_rc < 0) {
- return Nullfp;
+ return NULL;
}
if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
SV *sv;
const char *name;
STRLEN len;
- const char *tryname = Nullch;
- SV *namesv = Nullsv;
+ const char *tryname = NULL;
+ SV *namesv = NULL;
const I32 gimme = GIMME_V;
- PerlIO *tryrsfp = 0;
int filter_has_file = 0;
- GV *filter_child_proc = 0;
- SV *filter_state = 0;
- SV *filter_sub = 0;
- SV *hook_sv = 0;
+ PerlIO *tryrsfp = NULL;
+ GV *filter_child_proc = NULL;
+ SV *filter_state = NULL;
+ SV *filter_sub = NULL;
+ SV *hook_sv = NULL;
SV *encoding;
OP *op;
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",
I32 i;
#ifdef VMS
char *unixname;
- if ((unixname = tounixspec(name, Nullch)) != Nullch)
+ 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);
Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
PTR2UV(SvRV(dirsv)), name);
tryname = SvPVX_const(namesv);
- tryrsfp = 0;
+ tryrsfp = NULL;
ENTER;
SAVETMPS;
save the gv to manage the lifespan of
the pipe, but this didn't help. XXX */
filter_child_proc = (GV *)arg;
- (void)SvREFCNT_inc(filter_child_proc);
+ SvREFCNT_inc_simple_void(filter_child_proc);
}
else {
if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
PerlIO_close(IoOFP(io));
}
- IoIFP(io) = Nullfp;
- IoOFP(io) = Nullfp;
+ IoIFP(io) = NULL;
+ IoOFP(io) = NULL;
}
}
if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVCV) {
filter_sub = arg;
- (void)SvREFCNT_inc(filter_sub);
+ SvREFCNT_inc_void_NN(filter_sub);
if (i < count) {
filter_state = SP[i];
- (void)SvREFCNT_inc(filter_state);
+ SvREFCNT_inc_simple_void(filter_state);
}
- if (tryrsfp == 0) {
- tryrsfp = PerlIO_open("/dev/null",
- PERL_SCRIPT_MODE);
+ if (!tryrsfp) {
+ tryrsfp = PerlIO_open("/dev/null", PERL_SCRIPT_MODE);
}
}
SP--;
filter_has_file = 0;
if (filter_child_proc) {
SvREFCNT_dec(filter_child_proc);
- filter_child_proc = 0;
+ filter_child_proc = NULL;
}
if (filter_state) {
SvREFCNT_dec(filter_state);
- filter_state = 0;
+ filter_state = NULL;
}
if (filter_sub) {
SvREFCNT_dec(filter_sub);
- filter_sub = 0;
+ filter_sub = NULL;
}
}
else {
#else
# ifdef VMS
char *unixdir;
- if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
+ if ((unixdir = tounixpath(dir, NULL)) == NULL)
continue;
sv_setpv(namesv, unixdir);
sv_catpv(namesv, unixname);
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);
}
}
} else {
SV** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
if (!svp)
- (void)hv_store(GvHVn(PL_incgv), name, len, SvREFCNT_inc(hook_sv), 0 );
+ (void)hv_store(GvHVn(PL_incgv), name, len, SvREFCNT_inc_simple(hook_sv), 0 );
}
ENTER;
SAVETMPS;
- lex_start(sv_2mortal(newSVpvn("",0)));
+ lex_start(sv_2mortal(newSVpvs("")));
SAVEGENERICSV(PL_rsfp_filters);
PL_rsfp_filters = NULL;
else
PL_compiling.cop_warnings = pWARN_STD ;
SAVESPTR(PL_compiling.cop_io);
- PL_compiling.cop_io = Nullsv;
+ PL_compiling.cop_io = NULL;
if (filter_sub || filter_child_proc) {
- SV * const datasv = filter_add(S_run_user_filter, Nullsv);
+ SV * const datasv = filter_add(S_run_user_filter, NULL);
IoLINES(datasv) = filter_has_file;
IoFMT_GV(datasv) = (GV *)filter_child_proc;
IoTOP_GV(datasv) = (GV *)filter_state;
/* 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);
/* Store and reset encoding. */
encoding = PL_encoding;
- PL_encoding = Nullsv;
+ 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;
OP *ret;
CV* runcv;
U32 seq;
- HV *saved_hh = 0;
+ HV *saved_hh = NULL;
if (PL_op->op_private & OPpEVAL_HAS_HH) {
saved_hh = (HV*) SvREFCNT_inc(POPs);
/* 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 */
PP(pp_leavetry)
{
dVAR; dSP;
- register SV **mark;
SV **newsp;
PMOP *newpm;
I32 gimme;
if (gimme == G_VOID)
SP = newsp;
else if (gimme == G_SCALAR) {
+ register SV **mark;
MARK = newsp + 1;
if (MARK <= SP) {
if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
}
else {
/* in case LEAVE wipes old return values */
+ register SV **mark;
for (mark = newsp + 1; mark <= SP; mark++) {
if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
*mark = sv_mortalcopy(*mark);
SAVETMPS;
if (PL_op->op_targ == 0) {
- SV **defsv_p = &GvSV(PL_defgv);
+ SV ** const defsv_p = &GvSV(PL_defgv);
*defsv_p = newSVsv(POPs);
SAVECLEARSV(*defsv_p);
}
I32 gimme;
SV **newsp;
PMOP *newpm;
- SV **mark;
+ PERL_UNUSED_CONTEXT;
POPBLOCK(cx,newpm);
assert(CxTYPE(cx) == CXt_GIVEN);
- mark = newsp;
SP = newsp;
PUTBACK;
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' */
# define SM_SEEN_THIS(sv) hv_exists_ent(seen_this, \
- sv_2mortal(newSViv((IV) sv)), 0)
+ sv_2mortal(newSViv(PTR2IV(sv))), 0)
# define SM_SEEN_OTHER(sv) hv_exists_ent(seen_other, \
- sv_2mortal(newSViv((IV) sv)), 0)
+ sv_2mortal(newSViv(PTR2IV(sv))), 0)
tryAMAGICbinSET(smart, 0);
tied = TRUE;
}
else if (SvTIED_mg((SV *) other_hv, PERL_MAGIC_tied)) {
- HV * temp = other_hv;
+ HV * const temp = other_hv;
other_hv = (HV *) this;
this = (SV *) temp;
tied = TRUE;
(void) hv_iterinit((HV *) this);
while ( (he = hv_iternext((HV *) this)) ) {
I32 key_len;
- char *key = hv_iterkey(he, &key_len);
+ char * const key = hv_iterkey(he, &key_len);
++ this_key_count;
RETPUSHYES;
}
else if (SM_OTHER_REF(PVAV)) {
- AV *other_av = (AV *) SvRV(other);
- I32 other_len = av_len(other_av) + 1;
+ AV * const other_av = (AV *) SvRV(other);
+ const I32 other_len = av_len(other_av) + 1;
I32 i;
if (HvUSEDKEYS((HV *) this) != other_len)
RETPUSHNO;
for(i = 0; i < other_len; ++i) {
- SV **svp = av_fetch(other_av, i, FALSE);
+ SV ** const svp = av_fetch(other_av, i, FALSE);
char *key;
STRLEN key_len;
RETPUSHYES;
}
else if (SM_OTHER_REGEX) {
- PMOP *matcher = make_matcher(other_regex);
+ PMOP * const matcher = make_matcher(other_regex);
HE *he;
(void) hv_iterinit((HV *) this);
RETPUSHNO;
else {
I32 i;
- I32 other_len = av_len(other_av);
+ 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);
}
for(i = 0; i <= other_len; ++i) {
- SV **this_elem = av_fetch((AV *)this, i, FALSE);
- SV **other_elem = av_fetch(other_av, i, FALSE);
-
+ SV * const * const this_elem = av_fetch((AV *)this, i, FALSE);
+ SV * const * const other_elem = av_fetch(other_av, i, FALSE);
+
if (!this_elem || !other_elem) {
if (this_elem || other_elem)
RETPUSHNO;
}
else {
hv_store_ent(seen_this,
- sv_2mortal(newSViv((IV) *this_elem)),
+ sv_2mortal(newSViv(PTR2IV(*this_elem))),
&PL_sv_undef, 0);
hv_store_ent(seen_other,
- sv_2mortal(newSViv((IV) *other_elem)),
+ sv_2mortal(newSViv(PTR2IV(*other_elem))),
&PL_sv_undef, 0);
PUSHs(*this_elem);
PUSHs(*other_elem);
}
}
else if (SM_OTHER_REGEX) {
- PMOP *matcher = make_matcher(other_regex);
+ PMOP * const matcher = make_matcher(other_regex);
+ const I32 this_len = av_len((AV *) this);
I32 i;
- I32 this_len = av_len((AV *) this);
for(i = 0; i <= this_len; ++i) {
- SV ** svp = av_fetch((AV *)this, i, FALSE);
+ SV * const * const svp = av_fetch((AV *)this, i, FALSE);
if (svp && matcher_matches_sv(matcher, *svp)) {
destroy_matcher(matcher);
RETPUSHYES;
I32 i;
for(i = 0; i <= AvFILL((AV *) this); ++i) {
- SV ** svp = av_fetch((AV *)this, i, FALSE);
+ SV * const * const svp = av_fetch((AV *)this, i, FALSE);
if (!svp)
continue;
RETPUSHNO;
}
else if (SvPOK(other)) {
+ const I32 this_len = av_len((AV *) this);
I32 i;
- I32 this_len = av_len((AV *) this);
for(i = 0; i <= this_len; ++i) {
- SV ** svp = av_fetch((AV *)this, i, FALSE);
+ SV * const * const svp = av_fetch((AV *)this, i, FALSE);
if (!svp)
continue;
RETPUSHNO;
}
else if (SM_REGEX) {
- PMOP *matcher = make_matcher(this_regex);
+ PMOP * const matcher = make_matcher(this_regex);
PUTBACK;
PUSHs(matcher_matches_sv(matcher, other)
{
STRLEN len;
register char *s = SvPV_force(sv, len);
- register char *send = s + len;
- register char *base = Nullch;
+ register char * const send = s + len;
+ register char *base = NULL;
register I32 skipspaces = 0;
bool noblank = FALSE;
bool repeat = FALSE;
bool postspace = FALSE;
U32 *fops;
register U32 *fpc;
- U32 *linepc = 0;
+ U32 *linepc = NULL;
register I32 arg;
bool ischop;
bool unchopnum = FALSE;
maxops += 10;
}
s = base;
- base = Nullch;
+ base = NULL;
Newx(fops, maxops, U32);
fpc = fops;
}
Copy(fops, s, arg, U32);
Safefree(fops);
- sv_magic(sv, Nullsv, PERL_MAGIC_fm, Nullch, 0);
+ sv_magic(sv, NULL, PERL_MAGIC_fm, NULL, 0);
SvCOMPILED_on(sv);
if (unchopnum && repeat)
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