S_del_body is sufficiently small that inlining it is a space win.
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index 02aab31..62b128a 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -336,11 +336,8 @@ perl_construct(pTHXx)
        if ((long) PL_mmap_page_size < 0) {
          if (errno) {
            SV *error = ERRSV;
-           char *msg;
-           STRLEN n_a;
            (void) SvUPGRADE(error, SVt_PV);
-           msg = SvPVx(error, n_a);
-           Perl_croak(aTHX_ "panic: sysconf: %s", msg);
+           Perl_croak(aTHX_ "panic: sysconf: %s", SvPV_nolen_const(error));
          }
          else
            Perl_croak(aTHX_ "panic: sysconf: pagesize unknown");
@@ -837,8 +834,6 @@ perl_destruct(pTHXx)
     /* free the pointer tables used for cloning */
     ptr_table_free(PL_ptr_table);
     PL_ptr_table = (PTR_TBL_t*)NULL;
-    ptr_table_free(PL_shared_hek_table);
-    PL_shared_hek_table = (PTR_TBL_t*)NULL;
 #endif
 
     /* free special SVs */
@@ -1004,7 +999,7 @@ perl_free(pTHXx)
 /* provide destructors to clean up the thread key when libperl is unloaded */
 #ifndef WIN32 /* handled during DLL_PROCESS_DETACH in win32/perllib.c */
 
-#if defined(__hpux) && && __ux_version > 1020 && !defined(__GNUC__)
+#if defined(__hpux) && __ux_version > 1020 && !defined(__GNUC__)
 #pragma fini "perl_fini"
 #endif
 
@@ -1287,7 +1282,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     register SV *sv;
     register char *s;
     const char *cddir = Nullch;
+#ifdef USE_SITECUSTOMIZE
     bool minus_f = FALSE;
+#endif
 
     PL_fdscript = -1;
     PL_suidscript = -1;
@@ -1382,7 +1379,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            break;
 
        case 'f':
+#ifdef USE_SITECUSTOMIZE
            minus_f = TRUE;
+#endif
            s++;
            goto reswitch;
 
@@ -2282,7 +2281,6 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     UNOP myop;         /* fake syntax tree node */
     volatile I32 oldmark = SP - PL_stack_base;
     volatile I32 retval = 0;
-    I32 oldscope;
     int ret;
     OP* oldop = PL_op;
     dJMPENV;
@@ -2297,7 +2295,6 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     Zero(PL_op, 1, UNOP);
     EXTEND(PL_stack_sp, 1);
     *++PL_stack_sp = sv;
-    oldscope = PL_scopestack_ix;
 
     if (!(flags & G_NOARGS))
        myop.op_flags = OPf_STACKED;
@@ -2383,8 +2380,7 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
     PUTBACK;
 
     if (croak_on_error && SvTRUE(ERRSV)) {
-       STRLEN n_a;
-       Perl_croak(aTHX_ SvPVx(ERRSV, n_a));
+       Perl_croak(aTHX_ SvPVx_nolen_const(ERRSV));
     }
 
     return sv;
@@ -2435,37 +2431,35 @@ S_usage(pTHX_ const char *name)         /* XXX move this out into a module ? */
      * Removed -h because the user already knows that option. Others? */
 
     static const char * const usage_msg[] = {
-"-0[octal]       specify record separator (\\0, if no argument)",
-"-A[name]        activate all/given assertions",
-"-a              autosplit mode with -n or -p (splits $_ into @F)",
-"-C[number/list] enables the listed Unicode features",
-"-c              check syntax only (runs BEGIN and CHECK blocks)",
-"-d[:debugger]   run program under debugger",
-"-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
-"-e program      one line of program (several -e's allowed, omit programfile)",
-#ifdef USE_SITECUSTOMIZE
-"-f              don't do $sitelib/sitecustomize.pl at startup",
-#endif
-"-F/pattern/     split() pattern for -a switch (//'s are optional)",
-"-i[extension]   edit <> files in place (makes backup if extension supplied)",
-"-Idirectory     specify @INC/#include directory (several -I's allowed)",
-"-l[octal]       enable line ending processing, specifies line terminator",
-"-[mM][-]module  execute \"use/no module...\" before executing program",
-"-n              assume \"while (<>) { ... }\" loop around program",
-"-p              assume loop like -n but print line also, like sed",
-"-P              run program through C preprocessor before compilation",
-"-s              enable rudimentary parsing for switches after programfile",
-"-S              look for programfile using PATH environment variable",
-"-t              enable tainting warnings",
-"-T              enable tainting checks",
-"-u              dump core after parsing program",
-"-U              allow unsafe operations",
-"-v              print version, subversion (includes VERY IMPORTANT perl info)",
-"-V[:variable]   print configuration summary (or a single Config.pm variable)",
-"-w              enable many useful warnings (RECOMMENDED)",
-"-W              enable all warnings",
-"-x[directory]   strip off text before #!perl line and perhaps cd to directory",
-"-X              disable all warnings",
+"-0[octal]         specify record separator (\\0, if no argument)",
+"-A[mod][=pattern] activate all/given assertions",
+"-a                autosplit mode with -n or -p (splits $_ into @F)",
+"-C[number/list]   enables the listed Unicode features",
+"-c                check syntax only (runs BEGIN and CHECK blocks)",
+"-d[:debugger]     run program under debugger",
+"-D[number/list]   set debugging flags (argument is a bit mask or alphabets)",
+"-e program        one line of program (several -e's allowed, omit programfile)",
+"-f                don't do $sitelib/sitecustomize.pl at startup",
+"-F/pattern/       split() pattern for -a switch (//'s are optional)",
+"-i[extension]     edit <> files in place (makes backup if extension supplied)",
+"-Idirectory       specify @INC/#include directory (several -I's allowed)",
+"-l[octal]         enable line ending processing, specifies line terminator",
+"-[mM][-]module    execute \"use/no module...\" before executing program",
+"-n                assume \"while (<>) { ... }\" loop around program",
+"-p                assume loop like -n but print line also, like sed",
+"-P                run program through C preprocessor before compilation",
+"-s                enable rudimentary parsing for switches after programfile",
+"-S                look for programfile using PATH environment variable",
+"-t                enable tainting warnings",
+"-T                enable tainting checks",
+"-u                dump core after parsing program",
+"-U                allow unsafe operations",
+"-v                print version, subversion (includes VERY IMPORTANT perl info)",
+"-V[:variable]     print configuration summary (or a single Config.pm variable)",
+"-w                enable many useful warnings (RECOMMENDED)",
+"-W                enable all warnings",
+"-x[directory]     strip off text before #!perl line and perhaps cd to directory",
+"-X                disable all warnings",
 "\n",
 NULL
 };
@@ -2660,7 +2654,6 @@ Perl_moreswitches(pTHX_ char *s)
                   "Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n");
        for (s++; isALNUM(*s); s++) ;
 #endif
-       /*SUPPRESS 530*/
        return s;
     }  
     case 'h':
@@ -2676,8 +2669,8 @@ Perl_moreswitches(pTHX_ char *s)
        }
 #endif /* __CYGWIN__ */
        PL_inplace = savepv(s+1);
-       /*SUPPRESS 530*/
-       for (s = PL_inplace; *s && !isSPACE(*s); s++) ;
+       for (s = PL_inplace; *s && !isSPACE(*s); s++)
+           ;
        if (*s) {
            *s++ = '\0';
            if (*s == '-')      /* Additional switches on #! line. */
@@ -2737,17 +2730,27 @@ Perl_moreswitches(pTHX_ char *s)
        forbid_setid("-A");
        if (!PL_preambleav)
            PL_preambleav = newAV();
-       if (*++s) {
-           SV *sv = newSVpv("use assertions::activate split(/,/,q", 0);
-           sv_catpvn(sv, "\0", 1);     /* Use NUL as q//-delimiter. */
-           sv_catpv(sv,s);
-           sv_catpvn(sv, "\0)", 2);
-           s+=strlen(s);
+       s++;
+       {
+           char *start = s;
+           SV *sv = newSVpv("use assertions::activate", 24);
+           while(isALNUM(*s) || *s == ':') ++s;
+           if (s != start) {
+               sv_catpvn(sv, "::", 2);
+               sv_catpvn(sv, start, s-start);
+           }
+           if (*s == '=') {
+               sv_catpvn(sv, " split(/,/,q\0", 13);
+               sv_catpv(sv, s+1);
+               sv_catpvn(sv, "\0)", 2);
+               s+=strlen(s);
+           }
+           else if (*s != '\0') {
+               Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, s-start, start);
+           }
            av_push(PL_preambleav, sv);
+           return s;
        }
-       else
-           av_push(PL_preambleav, newSVpvn("use assertions::activate",24));
-       return s;
     case 'M':
        forbid_setid("-M");     /* XXX ? */
        /* FALL THROUGH */
@@ -3186,7 +3189,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 
        DEBUG_P(PerlIO_printf(Perl_debug_log,
                              "PL_preprocess: scriptname=\"%s\", cpp=\"%s\", sv=\"%s\", CPPMINUS=\"%s\"\n",
-                             scriptname, SvPVX (cpp), SvPVX (sv), CPPMINUS));
+                             scriptname, SvPVX_const (cpp), SvPVX_const (sv),
+                             CPPMINUS));
 
 #       if defined(MSDOS) || defined(WIN32) || defined(VMS)
             quote = "\"";
@@ -3227,9 +3231,9 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 
         DEBUG_P(PerlIO_printf(Perl_debug_log,
                               "PL_preprocess: cmd=\"%s\"\n",
-                              SvPVX(cmd)));
+                              SvPVX_const(cmd)));
 
-       PL_rsfp = PerlProc_popen(SvPVX(cmd), (char *)"r");
+       PL_rsfp = PerlProc_popen((char *)SvPVX_const(cmd), (char *)"r");
        SvREFCNT_dec(cmd);
        SvREFCNT_dec(cpp);
     }
@@ -3424,13 +3428,13 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
      */
 
 #ifdef DOSUID
-    char *s, *s2;
+    const char *s, *s2;
 
     if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0) /* normal stat is insecure */
        Perl_croak(aTHX_ "Can't stat script \"%s\"",PL_origfilename);
     if (PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
        I32 len;
-       STRLEN n_a;
+       const char *linestr;
 
 #ifdef IAMSUID
        if (PL_fdscript < 0 || PL_suidscript != 1)
@@ -3528,10 +3532,12 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
        PL_doswitches = FALSE;          /* -s is insecure in suid */
        /* PSz 13 Nov 03  But -s was caught elsewhere ... so unsetting it here is useless(?!) */
        CopLINE_inc(PL_curcop);
+       linestr = SvPV_nolen_const(PL_linestr);
        if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
-         strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */
+         strnNE(linestr,"#!",2) )      /* required even on Sys V */
            Perl_croak(aTHX_ "No #! line");
-       s = SvPV(PL_linestr,n_a)+2;
+       linestr+=2;
+       s = linestr;
        /* PSz 27 Feb 04 */
        /* Sanity check on line length */
        if (strlen(s) < 1 || strlen(s) > 4000)
@@ -3540,12 +3546,12 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
        while (isSPACE(*s)) s++;
        /* Sanity check on buffer end */
        while ((*s) && !isSPACE(*s)) s++;
-       for (s2 = s;  (s2 > SvPV(PL_linestr,n_a)+2 &&
+       for (s2 = s;  (s2 > linestr &&
                       (isDIGIT(s2[-1]) || s2[-1] == '.' || s2[-1] == '_'
                        || s2[-1] == '-'));  s2--) ;
        /* Sanity check on buffer start */
-       if ( (s2-4 < SvPV(PL_linestr,n_a)+2 || strnNE(s2-4,"perl",4)) &&
-             (s-9 < SvPV(PL_linestr,n_a)+2 || strnNE(s-9,"perl",4)) )
+       if ( (s2-4 < linestr || strnNE(s2-4,"perl",4)) &&
+             (s-9 < linestr || strnNE(s-9,"perl",4)) )
            Perl_croak(aTHX_ "Not a perl script");
        while (*s == ' ' || *s == '\t') s++;
        /*
@@ -3835,7 +3841,6 @@ S_find_beginning(pTHX)
                while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
                       || s2[-1] == '_') s2--;
                if (strnEQ(s2-4,"perl",4))
-                   /*SUPPRESS 530*/
                    while ((s = moreswitches(s)))
                        ;
            }
@@ -4365,7 +4370,7 @@ STATIC SV *
 S_incpush_if_exists(pTHX_ SV *dir)
 {
     Stat_t tmpstatbuf;
-    if (PerlLIO_stat(SvPVX(dir), &tmpstatbuf) >= 0 &&
+    if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
        S_ISDIR(tmpstatbuf.st_mode)) {
        av_push(GvAVn(PL_incgv), dir);
        dir = NEWSV(0,0);
@@ -4705,7 +4710,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
        case 0:
            call_list_body(cv);
            atsv = ERRSV;
-           (void)SvPV(atsv, len);
+           (void)SvPV_const(atsv, len);
            if (len) {
                PL_curcop = &PL_compiling;
                CopLINE_set(PL_curcop, oldline);
@@ -4843,11 +4848,11 @@ S_my_exit_jump(pTHX)
 static I32
 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
-    char *p, *nl;
+    const char *p, *nl;
     (void)idx;
     (void)maxlen;
 
-    p  = SvPVX(PL_e_script);
+    p  = SvPVX_const(PL_e_script);
     nl = strchr(p, '\n');
     nl = (nl) ? nl+1 : SvEND(PL_e_script);
     if (nl-p == 0) {