s/Nullcv/NULL/g

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index ad901cc..7c08c77 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,7 +1,7 @@
 /*    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.
@@ -40,6 +40,7 @@
 
 PP(pp_wantarray)
 {
+    dVAR;
     dSP;
     I32 cxix;
     EXTEND(SP, 1);
@@ -60,6 +61,7 @@ PP(pp_wantarray)
 
 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;
@@ -69,6 +71,7 @@ PP(pp_regcreset)
 
 PP(pp_regcomp)
 {
+    dVAR;
     dSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
     SV *tmpstr;
@@ -180,6 +183,7 @@ PP(pp_regcomp)
 
 PP(pp_substcont)
 {
+    dVAR;
     dSP;
     register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
     register PMOP * const pm = (PMOP*) cLOGOP->op_other;
@@ -240,7 +244,7 @@ PP(pp_substcont)
            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);
@@ -385,7 +389,7 @@ Perl_rxres_free(pTHX_ void **rsp)
 
 PP(pp_formline)
 {
-    dSP; dMARK; dORIGMARK;
+    dVAR; dSP; dMARK; dORIGMARK;
     register SV * const tmpForm = *++MARK;
     register U32 *fpc;
     register char *t;
@@ -407,7 +411,7 @@ PP(pp_formline)
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;
     SV * nsv = NULL;
-    OP * parseres = 0;
+    OP * parseres = NULL;
     const char *fmt;
     bool oneline;
 
@@ -1047,6 +1051,7 @@ PP(pp_mapwhile)
 
 PP(pp_range)
 {
+    dVAR;
     if (GIMME == G_ARRAY)
        return NORMAL;
     if (SvTRUEx(PAD_SV(PL_op->op_targ)))
@@ -1057,6 +1062,7 @@ PP(pp_range)
 
 PP(pp_flip)
 {
+    dVAR;
     dSP;
 
     if (GIMME == G_ARRAY) {
@@ -1072,7 +1078,7 @@ PP(pp_flip)
                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));
            }
@@ -1111,7 +1117,7 @@ PP(pp_flip)
 
 PP(pp_flop)
 {
-    dSP;
+    dVAR; dSP;
 
     if (GIMME == G_ARRAY) {
        dPOPPOPssrl;
@@ -1166,7 +1172,7 @@ PP(pp_flop)
                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));
            }
        }
@@ -1176,7 +1182,7 @@ PP(pp_flop)
 
        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);
     }
@@ -1201,6 +1207,7 @@ static const char * const context_name[] = {
 STATIC I32
 S_dopoptolabel(pTHX_ const char *label)
 {
+    dVAR;
     register I32 i;
 
     for (i = cxstack_ix; i >= 0; i--) {
@@ -1237,6 +1244,7 @@ S_dopoptolabel(pTHX_ const char *label)
 I32
 Perl_dowantarray(pTHX)
 {
+    dVAR;
     const I32 gimme = block_gimme();
     return (gimme == G_VOID) ? G_SCALAR : gimme;
 }
@@ -1244,6 +1252,7 @@ Perl_dowantarray(pTHX)
 I32
 Perl_block_gimme(pTHX)
 {
+    dVAR;
     const I32 cxix = dopoptosub(cxstack_ix);
     if (cxix < 0)
        return G_VOID;
@@ -1265,6 +1274,7 @@ Perl_block_gimme(pTHX)
 I32
 Perl_is_lvalue_sub(pTHX)
 {
+    dVAR;
     const I32 cxix = dopoptosub(cxstack_ix);
     assert(cxix >= 0);  /* We should only be called from inside subs */
 
@@ -1277,12 +1287,14 @@ Perl_is_lvalue_sub(pTHX)
 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];
@@ -1302,6 +1314,7 @@ S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
 STATIC I32
 S_dopoptoeval(pTHX_ I32 startingblock)
 {
+    dVAR;
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        register const PERL_CONTEXT *cx = &cxstack[i];
@@ -1319,6 +1332,7 @@ S_dopoptoeval(pTHX_ I32 startingblock)
 STATIC I32
 S_dopoptoloop(pTHX_ I32 startingblock)
 {
+    dVAR;
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        register const PERL_CONTEXT * const cx = &cxstack[i];
@@ -1345,6 +1359,7 @@ S_dopoptoloop(pTHX_ I32 startingblock)
 STATIC I32
 S_dopoptogiven(pTHX_ I32 startingblock)
 {
+    dVAR;
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        register const PERL_CONTEXT *cx = &cxstack[i];
@@ -1367,6 +1382,7 @@ S_dopoptogiven(pTHX_ I32 startingblock)
 STATIC I32
 S_dopoptowhen(pTHX_ I32 startingblock)
 {
+    dVAR;
     I32 i;
     for (i = startingblock; i >= 0; i--) {
        register const PERL_CONTEXT *cx = &cxstack[i];
@@ -1384,6 +1400,7 @@ S_dopoptowhen(pTHX_ I32 startingblock)
 void
 Perl_dounwind(pTHX_ I32 cxix)
 {
+    dVAR;
     I32 optype;
 
     while (cxstack_ix > cxix) {
@@ -1420,6 +1437,7 @@ Perl_dounwind(pTHX_ I32 cxix)
 void
 Perl_qerror(pTHX_ SV *err)
 {
+    dVAR;
     if (PL_in_eval)
        sv_catsv(ERRSV, err);
     else if (PL_errors)
@@ -1527,7 +1545,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 
 PP(pp_xor)
 {
-    dSP; dPOPTOPssrl;
+    dVAR; dSP; dPOPTOPssrl;
     if (SvTRUE(left) != SvTRUE(right))
        RETSETYES;
     else
@@ -1536,6 +1554,7 @@ PP(pp_xor)
 
 PP(pp_caller)
 {
+    dVAR;
     dSP;
     register I32 cxix = dopoptosub(cxstack_ix);
     register const PERL_CONTEXT *cx;
@@ -1608,18 +1627,18 @@ PP(pp_caller)
        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;
@@ -1655,7 +1674,7 @@ PP(pp_caller)
        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) */
@@ -1684,7 +1703,7 @@ PP(pp_caller)
             * 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 {
@@ -1700,6 +1719,7 @@ PP(pp_caller)
 
 PP(pp_reset)
 {
+    dVAR;
     dSP;
     const char * const tmps = (MAXARG < 1) ? "" : POPpconstx;
     sv_reset(tmps, CopSTASH(PL_curcop));
@@ -1799,7 +1819,7 @@ PP(pp_enteriter)
        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
@@ -2203,6 +2223,7 @@ PP(pp_redo)
 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";
 
@@ -2250,12 +2271,12 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
 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";
 
@@ -2488,10 +2509,10 @@ PP(pp_goto)
        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 */
 
@@ -2607,6 +2628,7 @@ PP(pp_goto)
 
 PP(pp_exit)
 {
+    dVAR;
     dSP;
     I32 anum;
 
@@ -2626,46 +2648,6 @@ PP(pp_exit)
     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
@@ -2677,7 +2659,7 @@ S_save_lines(pTHX_ AV *array, SV *sv)
 
     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');
@@ -2695,6 +2677,7 @@ S_save_lines(pTHX_ AV *array, SV *sv)
 STATIC void
 S_docatch_body(pTHX)
 {
+    dVAR;
     CALLRUNOPS(aTHX);
     return;
 }
@@ -2702,6 +2685,7 @@ S_docatch_body(pTHX)
 STATIC OP *
 S_docatch(pTHX_ OP *o)
 {
+    dVAR;
     int ret;
     OP * const oldop = PL_op;
     dJMPENV;
@@ -2767,7 +2751,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     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;
@@ -2859,6 +2843,7 @@ than in the scope of the debugger itself).
 CV*
 Perl_find_runcv(pTHX_ U32 *db_seqp)
 {
+    dVAR;
     PERL_SI     *si;
 
     if (db_seqp)
@@ -2904,7 +2889,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     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);
@@ -2937,7 +2922,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     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);
@@ -3106,7 +3091,7 @@ PP(pp_require)
 
        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",
@@ -3159,7 +3144,7 @@ PP(pp_require)
        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);
 
@@ -3340,23 +3325,22 @@ PP(pp_require)
                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);
                }    
            }
@@ -3381,7 +3365,7 @@ PP(pp_require)
 
     ENTER;
     SAVETMPS;
-    lex_start(sv_2mortal(newSVpvn("",0)));
+    lex_start(sv_2mortal(newSVpvs("")));
     SAVEGENERICSV(PL_rsfp_filters);
     PL_rsfp_filters = NULL;
 
@@ -3422,7 +3406,7 @@ PP(pp_require)
     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;
@@ -3710,6 +3694,7 @@ STATIC
 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));
     
@@ -3723,6 +3708,7 @@ STATIC
 bool
 S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
 {
+    dVAR;
     dSP;
     
     PL_op = (OP *) matcher;
@@ -3737,6 +3723,7 @@ STATIC
 void
 S_destroy_matcher(pTHX_ PMOP *matcher)
 {
+    dVAR;
     PERL_UNUSED_ARG(matcher);
     FREETMPS;
     LEAVE;
@@ -3789,6 +3776,7 @@ STATIC
 OP *
 S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
 {
+    dVAR;
     dSP;
     
     SV *e = TOPs;      /* e is for 'expression' */
@@ -4276,7 +4264,7 @@ S_doparseform(pTHX_ SV *sv)
     bool postspace = FALSE;
     U32 *fops;
     register U32 *fpc;
-    U32 *linepc = 0;
+    U32 *linepc = NULL;
     register I32 arg;
     bool ischop;
     bool unchopnum = FALSE;