This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
performance tweaking op.c
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index b8f3c71..6280145 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1,7 +1,7 @@
 /*    toke.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.
@@ -287,7 +287,7 @@ S_tokereport(pTHX_ I32 rv)
        const char *name = Nullch;
        enum token_type type = TOKENTYPE_NONE;
        const struct debug_tokens *p;
-       SV* const report = newSVpvn("<== ", 4);
+       SV* const report = newSVpvs("<== ");
 
        for (p = debug_tokens; p->token; p++) {
            if (p->token == (int)rv) {
@@ -301,7 +301,7 @@ S_tokereport(pTHX_ I32 rv)
        else if ((char)rv > ' ' && (char)rv < '~')
            Perl_sv_catpvf(aTHX_ report, "'%c'", (char)rv);
        else if (!rv)
-           Perl_sv_catpv(aTHX_ report, "EOF");
+           sv_catpvs(report, "EOF");
        else
            Perl_sv_catpvf(aTHX_ report, "?? %"IVdf, (IV)rv);
        switch (type) {
@@ -329,7 +329,7 @@ S_tokereport(pTHX_ I32 rv)
 
            }
            else
-               Perl_sv_catpv(aTHX_ report, "(opval=null)");
+               sv_catpvs(report, "(opval=null)");
            break;
        }
         PerlIO_printf(Perl_debug_log, "### %s\n\n", SvPV_nolen_const(report));
@@ -343,7 +343,7 @@ S_tokereport(pTHX_ I32 rv)
 STATIC void
 S_printbuf(pTHX_ const char* fmt, const char* s)
 {
-    SV* const tmp = newSVpvn("", 0);
+    SV* const tmp = newSVpvs("");
     PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
     SvREFCNT_dec(tmp);
 }
@@ -458,9 +458,9 @@ S_missingterm(pTHX_ char *s)
     Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
 }
 
-#define FEATURE_IS_ENABLED(name, namelen)                              \
+#define FEATURE_IS_ENABLED(name)                                       \
        ((0 != (PL_hints & HINT_LOCALIZE_HH))                           \
-           && feature_is_enabled(name, namelen) )
+           && S_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
 /*
  * S_feature_is_enabled
  * Check whether the named feature is enabled.
@@ -609,7 +609,7 @@ Perl_lex_start(pTHX_ SV *line)
     if (!len || s[len-1] != ';') {
        if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
            PL_linestr = sv_2mortal(newSVsv(PL_linestr));
-       sv_catpvn(PL_linestr, "\n;", 2);
+       sv_catpvs(PL_linestr, "\n;");
     }
     SvTEMP_off(PL_linestr);
     PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
@@ -841,7 +841,7 @@ S_skipspace(pTHX_ register char *s)
            sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
             (void)SvIOK_on(sv);
             SvIV_set(sv, 0);
-           av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+           av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
        }
     }
 }
@@ -1290,7 +1290,7 @@ S_sublex_done(pTHX)
 {
     dVAR;
     if (!PL_lex_starts++) {
-       SV * const sv = newSVpvn("",0);
+       SV * const sv = newSVpvs("");
        if (SvUTF8(PL_linestr))
            SvUTF8_on(sv);
        PL_expect = XOPERATOR;
@@ -2421,7 +2421,7 @@ Perl_yylex(pTHX)
     bool bof = FALSE;
 
     DEBUG_T( {
-       SV* tmp = newSVpvn("", 0);
+       SV* tmp = newSVpvs("");
        PerlIO_printf(Perl_debug_log, "### %"IVdf":LEX_%s/X%s %s\n",
            (IV)CopLINE(PL_curcop),
            lex_state_names[PL_lex_state],
@@ -2672,21 +2672,21 @@ Perl_yylex(pTHX)
            PL_preambled = TRUE;
            sv_setpv(PL_linestr,incl_perldb());
            if (SvCUR(PL_linestr))
-               sv_catpvn(PL_linestr,";", 1);
+               sv_catpvs(PL_linestr,";");
            if (PL_preambleav){
                while(AvFILLp(PL_preambleav) >= 0) {
                    SV *tmpsv = av_shift(PL_preambleav);
                    sv_catsv(PL_linestr, tmpsv);
-                   sv_catpvn(PL_linestr, ";", 1);
+                   sv_catpvs(PL_linestr, ";");
                    sv_free(tmpsv);
                }
                sv_free((SV*)PL_preambleav);
                PL_preambleav = NULL;
            }
            if (PL_minus_n || PL_minus_p) {
-               sv_catpv(PL_linestr, "LINE: while (<>) {");
+               sv_catpvs(PL_linestr, "LINE: while (<>) {");
                if (PL_minus_l)
-                   sv_catpv(PL_linestr,"chomp;");
+                   sv_catpvs(PL_linestr,"chomp;");
                if (PL_minus_a) {
                    if (PL_minus_F) {
                        if ((*PL_splitstr == '/' || *PL_splitstr == '\''
@@ -2696,11 +2696,8 @@ Perl_yylex(pTHX)
                        else {
                            /* "q\0${splitstr}\0" is legal perl. Yes, even NUL
                               bytes can be used as quoting characters.  :-) */
-                           /* The count here deliberately includes the NUL
-                              that terminates the C string constant.  This
-                              embeds the opening NUL into the string.  */
                            const char *splits = PL_splitstr;
-                           sv_catpvn(PL_linestr, "our @F=split(q", 15);
+                           sv_catpvs(PL_linestr, "our @F=split(q\0");
                            do {
                                /* Need to \ \s  */
                                if (*splits == '\\')
@@ -2710,16 +2707,16 @@ Perl_yylex(pTHX)
                            /* This loop will embed the trailing NUL of
                               PL_linestr as the last thing it does before
                               terminating.  */
-                           sv_catpvn(PL_linestr, ");", 2);
+                           sv_catpvs(PL_linestr, ");");
                        }
                    }
                    else
-                       sv_catpv(PL_linestr,"our @F=split(' ');");
+                       sv_catpvs(PL_linestr,"our @F=split(' ');");
                }
            }
            if (PL_minus_E)
-               sv_catpv(PL_linestr,"use feature ':5.10';");
-           sv_catpvn(PL_linestr, "\n", 1);
+               sv_catpvs(PL_linestr,"use feature ':5.10';");
+           sv_catpvs(PL_linestr, "\n");
            PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
            PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
            PL_last_lop = PL_last_uni = Nullch;
@@ -2730,7 +2727,7 @@ Perl_yylex(pTHX)
                sv_setsv(sv,PL_linestr);
                 (void)SvIOK_on(sv);
                 SvIV_set(sv, 0);
-               av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+               av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
            }
            goto retry;
        }
@@ -2817,7 +2814,7 @@ Perl_yylex(pTHX)
            sv_setsv(sv,PL_linestr);
             (void)SvIOK_on(sv);
             SvIV_set(sv, 0);
-           av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+           av_store(CopFILEAVx(PL_curcop),(I32)CopLINE(PL_curcop),sv);
        }
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
        PL_last_lop = PL_last_uni = Nullch;
@@ -2996,14 +2993,6 @@ Perl_yylex(pTHX)
                                (void)gv_fetchfile(PL_origfilename);
                            goto retry;
                        }
-                       if (PL_doswitches && !switches_done) {
-                           int argc = PL_origargc;
-                           char **argv = PL_origargv;
-                           do {
-                               argc--,argv++;
-                           } while (argc && argv[0][0] == '-' && argv[0][1]);
-                           init_argv_symbols(argc,argv);
-                       }
                    }
                }
            }
@@ -3214,7 +3203,7 @@ Perl_yylex(pTHX)
     case '~':
        if (s[1] == '~'
        && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR)
-       && FEATURE_IS_ENABLED("~~", 2))
+       && FEATURE_IS_ENABLED("~~"))
        {
            s += 2;
            Eop(OP_SMARTMATCH);
@@ -3805,7 +3794,7 @@ Perl_yylex(pTHX)
                                t++;
                            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                                        "Multidimensional syntax %.*s not supported",
-                                       (t - PL_bufptr) + 1, PL_bufptr);
+                                   (int)((t - PL_bufptr) + 1), PL_bufptr);
                        }
                    }
                }
@@ -3910,7 +3899,8 @@ Perl_yylex(pTHX)
                        PL_bufptr = skipspace(PL_bufptr);
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                            "Scalar value %.*s better written as $%.*s",
-                           t-PL_bufptr, PL_bufptr, t-PL_bufptr-1, PL_bufptr+1);
+                           (int)(t-PL_bufptr), PL_bufptr,
+                           (int)(t-PL_bufptr-1), PL_bufptr+1);
                    }
                }
            }
@@ -4116,8 +4106,8 @@ Perl_yylex(pTHX)
       keylookup: {
        I32 tmp;
        I32 orig_keyword = 0;
-       GV *gv = Nullgv;
-       GV **gvp = 0;
+       GV *gv = NULL;
+       GV **gvp = NULL;
 
        PL_bufptr = s;
        s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len);
@@ -4159,8 +4149,8 @@ Perl_yylex(pTHX)
        }
 
        if (tmp < 0) {                  /* second-class keyword? */
-           GV *ogv = Nullgv;   /* override (winner) */
-           GV *hgv = Nullgv;   /* hidden (loser) */
+           GV *ogv = NULL;     /* override (winner) */
+           GV *hgv = NULL;     /* hidden (loser) */
            if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
                CV *cv;
                if ((gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV)) &&
@@ -4280,7 +4270,7 @@ Perl_yylex(pTHX)
                /* if we saw a global override before, get the right name */
 
                if (gvp) {
-                   sv = newSVpvn("CORE::GLOBAL::",14);
+                   sv = newSVpvs("CORE::GLOBAL::");
                    sv_catpv(sv,PL_tokenbuf);
                }
                else {
@@ -4647,7 +4637,7 @@ Perl_yylex(pTHX)
            /* When 'use switch' is in effect, continue has a dual
               life as a control operator. */
            {
-               if (!FEATURE_IS_ENABLED("switch", 6))
+               if (!FEATURE_IS_ENABLED("switch"))
                    PREBLOCK(CONTINUE);
                else {
                    /* We have to disambiguate the two senses of
@@ -5437,7 +5427,7 @@ Perl_yylex(pTHX)
                        sv_setpv(PL_subname, tmpbuf);
                    else {
                        sv_setsv(PL_subname,PL_curstname);
-                       sv_catpvn(PL_subname,"::",2);
+                       sv_catpvs(PL_subname,"::");
                        sv_catpvn(PL_subname,tmpbuf,len);
                    }
                    s = skipspace(d);
@@ -5723,7 +5713,7 @@ S_pending_ident(pTHX)
                HV *  const stash = PAD_COMPNAME_OURSTASH(tmp);
                HEK * const stashname = HvNAME_HEK(stash);
                SV *  const sym = newSVhek(stashname);
-                sv_catpvn(sym, "::", 2);
+                sv_catpvs(sym, "::");
                 sv_catpv(sym, PL_tokenbuf+1);
                 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
                 yylval.opval->op_private = OPpCONST_ENTERED;
@@ -6080,7 +6070,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
             case 'r':
               if (name[2] == 'r')
               {                                   /* err        */
-                return (FEATURE_IS_ENABLED("err", 3) ? -KEY_err : 0);
+                return (FEATURE_IS_ENABLED("err") ? -KEY_err : 0);
               }
 
               goto unknown;
@@ -6219,7 +6209,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
             case 'a':
               if (name[2] == 'y')
               {                                   /* say        */
-                return (FEATURE_IS_ENABLED("say", 3) ? -KEY_say : 0);
+                return (FEATURE_IS_ENABLED("say") ? -KEY_say : 0);
               }
 
               goto unknown;
@@ -6743,7 +6733,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
               if (name[2] == 'e' &&
                   name[3] == 'n')
               {                                   /* when       */
-                return (FEATURE_IS_ENABLED("switch", 6) ? KEY_when : 0);
+                return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
           }
 
           goto unknown;
@@ -6826,7 +6816,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
                   name[3] == 'a' &&
                   name[4] == 'k')
               {                                   /* break      */
-                return (FEATURE_IS_ENABLED("switch", 6) ? -KEY_break : 0);
+                return (FEATURE_IS_ENABLED("switch") ? -KEY_break : 0);
               }
 
               goto unknown;
@@ -6954,7 +6944,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
               name[3] == 'e' &&
               name[4] == 'n')
           {                                       /* given      */
-            return (FEATURE_IS_ENABLED("switch", 6) ? KEY_given : 0);
+            return (FEATURE_IS_ENABLED("switch") ? KEY_given : 0);
           }
 
           goto unknown;
@@ -7775,7 +7765,7 @@ Perl_keyword (pTHX_ const char *name, I32 len)
                         name[5] == 'l' &&
                         name[6] == 't')
                     {                             /* default    */
-                      return (FEATURE_IS_ENABLED("switch", 6) ? KEY_default : 0);
+                      return (FEATURE_IS_ENABLED("switch") ? KEY_default : 0);
                     }
 
                     goto unknown;
@@ -9291,7 +9281,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv,
 
     /* Check the eval first */
     if (!PL_in_eval && SvTRUE(ERRSV)) {
-       sv_catpv(ERRSV, "Propagated");
+       sv_catpvs(ERRSV, "Propagated");
        yyerror(SvPV_nolen_const(ERRSV)); /* Duplicates the message inside eval */
        (void)POPs;
        res = SvREFCNT_inc(sv);
@@ -9623,12 +9613,12 @@ S_scan_subst(pTHX_ char *start)
        PL_sublex_info.super_bufend = PL_bufend;
        PL_multi_end = 0;
        pm->op_pmflags |= PMf_EVAL;
-       repl = newSVpvn("",0);
+       repl = newSVpvs("");
        while (es-- > 0)
            sv_catpv(repl, es ? "eval " : "do ");
-       sv_catpvn(repl, "{ ", 2);
+       sv_catpvs(repl, "{ ");
        sv_catsv(repl, PL_lex_repl);
-       sv_catpvn(repl, " };", 2);
+       sv_catpvs(repl, " }");
        SvEVALED_on(repl);
        SvREFCNT_dec(PL_lex_repl);
        PL_lex_repl = repl;
@@ -9871,7 +9861,7 @@ S_scan_heredoc(pTHX_ register char *s)
            sv_setsv(sv,PL_linestr);
             (void)SvIOK_on(sv);
             SvIV_set(sv, 0);
-           av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
+           av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop),sv);
        }
        if (*s == term && memEQ(s,PL_tokenbuf,len)) {
            STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
@@ -10007,7 +9997,7 @@ S_scan_inputsymbol(pTHX_ char *start)
                    HV *stash = PAD_COMPNAME_OURSTASH(tmp);
                    HEK *stashname = HvNAME_HEK(stash);
                    SV *sym = sv_2mortal(newSVhek(stashname));
-                   sv_catpvn(sym, "::", 2);
+                   sv_catpvs(sym, "::");
                    sv_catpv(sym, d+1);
                    d = SvPVX(sym);
                    goto intro_sym;
@@ -10344,7 +10334,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
            sv_setsv(sv,PL_linestr);
             (void)SvIOK_on(sv);
             SvIV_set(sv, 0);
-           av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
+           av_store(CopFILEAVx(PL_curcop), (I32)CopLINE(PL_curcop), sv);
        }
 
        /* having changed the buffer, we must update PL_bufend */
@@ -10412,7 +10402,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
     NV nv;                             /* number read, as a double */
     SV *sv = Nullsv;                   /* place to put the converted number */
     bool floatit;                      /* boolean: int or float? */
-    const char *lastub = 0;            /* position of last underbar */
+    const char *lastub = NULL;         /* position of last underbar */
     static char const number_too_long[] = "Number too long";
 
     /* We use the first character to decide what type of number this is */
@@ -10789,7 +10779,7 @@ S_scan_formline(pTHX_ register char *s)
 {
     register char *eol;
     register char *t;
-    SV *stuff = newSVpvn("",0);
+    SV *stuff = newSVpvs("");
     bool needargs = FALSE;
     bool eofmt = FALSE;
 
@@ -10979,7 +10969,7 @@ Perl_yyerror(pTHX_ const char *s)
            where = "within string";
     }
     else {
-       SV *where_sv = sv_2mortal(newSVpvn("next char ", 10));
+       SV *where_sv = sv_2mortal(newSVpvs("next char "));
        if (yychar < 32)
            Perl_sv_catpvf(aTHX_ where_sv, "^%c", toCTRL(yychar));
        else if (isPRINT_LC(yychar))