Install nit : README.e2x should be installed, the other READMEs shouldn't

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 728f91c..7c881c4 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -242,7 +242,7 @@ perl_construct(pTHXx)
     if (!PL_linestr) {
        PL_curcop = &PL_compiling;      /* needed by ckWARN, right away */
 
-       PL_linestr = NEWSV(65,79);
+       PL_linestr = newSV(79);
        sv_upgrade(PL_linestr,SVt_PVIV);
 
        if (!SvREADONLY(&PL_sv_undef)) {
@@ -1335,6 +1335,7 @@ perl_fini(void)
 void
 Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
 {
+    dVAR;
     Renew(PL_exitlist, PL_exitlistlen+1, PerlExitListEntry);
     PL_exitlist[PL_exitlistlen].fn = fn;
     PL_exitlist[PL_exitlistlen].ptr = ptr;
@@ -1378,6 +1379,7 @@ S_procself_val(pTHX_ SV *sv, const char *arg0)
 
 STATIC void
 S_set_caret_X(pTHX) {
+    dVAR;
     GV* tmpgv = gv_fetchpv("\030",TRUE, SVt_PV); /* $^X */
     if (tmpgv) {
 #ifdef HAS_PROCSELFEXE
@@ -1437,7 +1439,10 @@ setuid perl scripts securely.\n");
     PL_origargc = argc;
     PL_origargv = argv;
 
-    {
+    if (PL_origalen != 0) {
+       PL_origalen = 1; /* don't use old PL_origalen if perl_parse() is called again */
+    }
+    else {
        /* Set PL_origalen be the sum of the contiguous argv[]
         * elements plus the size of the env in case that it is
         * contiguous with the argv[].  This is used in mg.c:Perl_magic_set()
@@ -1485,7 +1490,7 @@ setuid perl scripts securely.\n");
              }
         }
         /* Can we grab env area too to be used as the area for $0? */
-        if (PL_origenviron) {
+        if (s && PL_origenviron) {
              if ((PL_origenviron[0] == s + 1
 #ifdef OS2
                   || (PL_origenviron[0] == s + 9 && (s += 8))
@@ -1521,7 +1526,7 @@ setuid perl scripts securely.\n");
                   }
              }
         }
-        PL_origalen = s - PL_origargv[0] + 1;
+        PL_origalen = s ? s - PL_origargv[0] + 1 : 0;
     }
 
     if (PL_do_undump) {
@@ -1804,9 +1809,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef PL_OP_SLAB_ALLOC
                             " PL_OP_SLAB_ALLOC"
 #  endif
-#  ifdef SPRINTF_RETURNS_STRLEN
-                            " SPRINTF_RETURNS_STRLEN"
-#  endif
 #  ifdef THREADS_HAVE_PIDS
                             " THREADS_HAVE_PIDS"
 #  endif
@@ -1860,7 +1862,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                        /* break the line before that space */
 
                        opts = space - pv;
-                       sv_insert(opts_prog, opts, 0,
+                       Perl_sv_insert(aTHX_ opts_prog, opts, 0,
                                  STR_WITH_LEN("\\n                       "));
                    }
 
@@ -2062,7 +2064,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
     }
 
-    PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0);
+    PL_main_cv = PL_compcv = (CV*)newSV(0);
     sv_upgrade((SV *)PL_compcv, SVt_PVCV);
     CvUNIQUE_on(PL_compcv);
 
@@ -2220,6 +2222,7 @@ Tells a Perl interpreter to run.  See L<perlembed>.
 int
 perl_run(pTHXx)
 {
+    dVAR;
     I32 oldscope;
     int ret = 0;
     dJMPENV;
@@ -2273,6 +2276,7 @@ perl_run(pTHXx)
 STATIC void
 S_run_body(pTHX_ I32 oldscope)
 {
+    dVAR;
     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
                     PL_sawampersand ? "Enabling" : "Omitting"));
 
@@ -2442,6 +2446,7 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
                        /* See G_* flags in cop.h */
                        /* null terminated arg list */
 {
+    dVAR;
     dSP;
 
     PUSHMARK(SP);
@@ -2647,6 +2652,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 STATIC void
 S_call_body(pTHX_ const OP *myop, bool is_eval)
 {
+    dVAR;
     if (PL_op == myop) {
        if (is_eval)
            PL_op = Perl_pp_entereval(aTHX);    /* this doesn't do a POPMARK */
@@ -2672,6 +2678,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 
                        /* See G_* flags in cop.h */
 {
+    dVAR;
     dSP;
     UNOP myop;         /* fake syntax tree node */
     volatile I32 oldmark = SP - PL_stack_base;
@@ -2764,6 +2771,7 @@ Tells Perl to C<eval> the given string and return an SV* result.
 SV*
 Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 {
+    dVAR;
     dSP;
     SV* sv = newSVpv(p, 0);
 
@@ -2797,8 +2805,9 @@ implemented that way; consider using load_module instead.
 void
 Perl_require_pv(pTHX_ const char *pv)
 {
-    SV* sv;
+    dVAR;
     dSP;
+    SV* sv;
     PUSHSTACKi(PERLSI_REQUIRE);
     PUTBACK;
     sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0);
@@ -3053,7 +3062,7 @@ Perl_moreswitches(pTHX_ char *s)
        Safefree(PL_inplace);
 #if defined(__CYGWIN__) /* do backup extension automagically */
        if (*(s+1) == '\0') {
-       PL_inplace = savepvn(STR_WITH_LEN(".bak"));
+       PL_inplace = savepvs(".bak");
        return s+1;
        }
 #endif /* __CYGWIN__ */
@@ -3219,7 +3228,11 @@ Perl_moreswitches(pTHX_ char *s)
            upg_version(PL_patchlevel);
 #if !defined(DGUX)
        PerlIO_printf(PerlIO_stdout(),
-               Perl_form(aTHX_ "\nThis is perl, %"SVf" built for %s",
+               Perl_form(aTHX_ "\nThis is perl, %"SVf
+#ifdef PERL_PATCHNUM
+                         " DEVEL" STRINGIFY(PERL_PATCHNUM)
+#endif
+                         " built for %s",
                    vstringify(PL_patchlevel),
                    ARCHNAME));
 #else /* DGUX */
@@ -3393,6 +3406,8 @@ Perl_my_unexec(pTHX)
 #  ifdef VMS
 #    include <lib$routines.h>
      lib$signal(SS$_DEBUG);  /* ssdef.h #included from vmsish.h */
+#  elif defined(WIN32) || defined(__CYGWIN__)
+    Perl_croak(aTHX_ "dump is not supported");
 #  else
     ABORT();           /* for use with undump */
 #  endif
@@ -3403,7 +3418,7 @@ Perl_my_unexec(pTHX)
 STATIC void
 S_init_interp(pTHX)
 {
-
+    dVAR;
 #ifdef MULTIPLICITY
 #  define PERLVAR(var,type)
 #  define PERLVARA(var,n,type)
@@ -3447,6 +3462,7 @@ S_init_interp(pTHX)
 STATIC void
 S_init_main_stash(pTHX)
 {
+    dVAR;
     GV *gv;
 
     PL_curstash = PL_defstash = newHV();
@@ -3505,7 +3521,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
     PL_suidscript = -1;
 
     if (PL_e_script) {
-       PL_origfilename = savepvn(STR_WITH_LEN("-e"));
+       PL_origfilename = savepvs("-e");
     }
     else {
        /* if find_script() returns, it returns a malloc()-ed value */
@@ -3576,7 +3592,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
     else if (PL_preprocess) {
        const char * const cpp_cfg = CPPSTDIN;
        SV * const cpp = newSVpvs("");
-       SV * const cmd = NEWSV(0,0);
+       SV * const cmd = newSV(0);
 
        if (cpp_cfg[0] == 0) /* PERL_MICRO? */
             Perl_croak(aTHX_ "Can't run with cpp -P with CPPSTDIN undefined");
@@ -3937,11 +3953,13 @@ 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);
+       if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch)
+           Perl_croak(aTHX_ "No #! line");
        linestr = SvPV_nolen_const(PL_linestr);
-       if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
-         strnNE(linestr,"#!",2) )      /* required even on Sys V */
+       /* required even on Sys V */
+       if (!*linestr || !linestr[1] || strnNE(linestr,"#!",2))
            Perl_croak(aTHX_ "No #! line");
-       linestr+=2;
+       linestr += 2;
        s = linestr;
        /* PSz 27 Feb 04 */
        /* Sanity check on line length */
@@ -4204,6 +4222,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 STATIC void
 S_find_beginning(pTHX)
 {
+    dVAR;
     register char *s;
     register const char *s2;
 #ifdef MACOS_TRADITIONAL
@@ -4273,6 +4292,7 @@ S_find_beginning(pTHX)
 STATIC void
 S_init_ids(pTHX)
 {
+    dVAR;
     PL_uid = PerlProc_getuid();
     PL_euid = PerlProc_geteuid();
     PL_gid = PerlProc_getgid();
@@ -4335,6 +4355,7 @@ Perl_doing_taint(int argc, char *argv[], char *envp[])
 STATIC void
 S_forbid_setid(pTHX_ const char *s)
 {
+    dVAR;
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
     if (PL_euid != PL_uid)
         Perl_croak(aTHX_ "No %s allowed while running setuid", s);
@@ -4374,6 +4395,7 @@ S_forbid_setid(pTHX_ const char *s)
 void
 Perl_init_debugger(pTHX)
 {
+    dVAR;
     HV * const ostash = PL_curstash;
 
     PL_curstash = PL_debstash;
@@ -4402,6 +4424,7 @@ Perl_init_debugger(pTHX)
 void
 Perl_init_stacks(pTHX)
 {
+    dVAR;
     /* start with 128-item stack and 8K cxstack */
     PL_curstackinfo = new_stackinfo(REASONABLE(128),
                                 REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
@@ -4438,6 +4461,7 @@ Perl_init_stacks(pTHX)
 STATIC void
 S_nuke_stacks(pTHX)
 {
+    dVAR;
     while (PL_curstackinfo->si_next)
        PL_curstackinfo = PL_curstackinfo->si_next;
     while (PL_curstackinfo) {
@@ -4456,6 +4480,7 @@ S_nuke_stacks(pTHX)
 STATIC void
 S_init_lexer(pTHX)
 {
+    dVAR;
     PerlIO *tmpfp;
     tmpfp = PL_rsfp;
     PL_rsfp = Nullfp;
@@ -4467,6 +4492,7 @@ S_init_lexer(pTHX)
 STATIC void
 S_init_predump_symbols(pTHX)
 {
+    dVAR;
     GV *tmpgv;
     IO *io;
 
@@ -4499,7 +4525,7 @@ S_init_predump_symbols(pTHX)
     GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
-    PL_statname = NEWSV(66,0);         /* last filename we did stat on */
+    PL_statname = newSV(0);            /* last filename we did stat on */
 
     Safefree(PL_osname);
     PL_osname = savepv(OSNAME);
@@ -4508,6 +4534,7 @@ S_init_predump_symbols(pTHX)
 void
 Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
 {
+    dVAR;
     argc--,argv++;     /* skip name of script */
     if (PL_doswitches) {
        for (; argc > 0 && **argv == '-'; argc--,argv++) {
@@ -4519,8 +4546,9 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
                break;
            }
            if ((s = strchr(argv[0], '='))) {
-               *s++ = '\0';
-               sv_setpv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),s);
+               *s = '\0';
+               sv_setpv(GvSV(gv_fetchpv(argv[0] + 1, TRUE, SVt_PV)), s + 1);
+               *s = '=';
            }
            else
                sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);
@@ -4549,10 +4577,10 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     dVAR;
     GV* tmpgv;
 
-    PL_toptarget = NEWSV(0,0);
+    PL_toptarget = newSV(0);
     sv_upgrade(PL_toptarget, SVt_PVFM);
     sv_setpvn(PL_toptarget, "", 0);
-    PL_bodytarget = NEWSV(0,0);
+    PL_bodytarget = newSV(0);
     sv_upgrade(PL_bodytarget, SVt_PVFM);
     sv_setpvn(PL_bodytarget, "", 0);
     PL_formtarget = PL_bodytarget;
@@ -4640,6 +4668,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 STATIC void
 S_init_perllib(pTHX)
 {
+    dVAR;
     char *s;
     if (!PL_tainting) {
 #ifndef VMS
@@ -4684,7 +4713,7 @@ S_init_perllib(pTHX)
 #ifdef MACOS_TRADITIONAL
     {
        Stat_t tmpstatbuf;
-       SV * privdir = NEWSV(55, 0);
+       SV * privdir = newSV(0);
        char * macperl = PerlEnv_getenv("MACPERL");
        
        if (!macperl)
@@ -4784,11 +4813,12 @@ S_init_perllib(pTHX)
 STATIC SV *
 S_incpush_if_exists(pTHX_ SV *dir)
 {
+    dVAR;
     Stat_t tmpstatbuf;
     if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
        S_ISDIR(tmpstatbuf.st_mode)) {
        av_push(GvAVn(PL_incgv), dir);
-       dir = NEWSV(0,0);
+       dir = newSV(0);
     }
     return dir;
 }
@@ -4797,6 +4827,7 @@ STATIC void
 S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
          bool canrelocate)
 {
+    dVAR;
     SV *subdir = Nullsv;
     const char *p = dir;
 
@@ -4804,12 +4835,12 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
        return;
 
     if (addsubdirs || addoldvers) {
-       subdir = NEWSV(0,0);
+       subdir = newSV(0);
     }
 
     /* Break at all separators */
     while (p && *p) {
-       SV *libdir = NEWSV(55,0);
+       SV *libdir = newSV(0);
         const char *s;
 
        /* skip any consecutive separators */
@@ -5067,10 +5098,10 @@ S_init_main_thread(pTHX)
      * because sv_setpvn does SvTAINT and the taint
      * fields thread selfness being set.
      */
-    PL_toptarget = NEWSV(0,0);
+    PL_toptarget = newSV(0);
     sv_upgrade(PL_toptarget, SVt_PVFM);
     sv_setpvn(PL_toptarget, "", 0);
-    PL_bodytarget = NEWSV(0,0);
+    PL_bodytarget = newSV(0);
     sv_upgrade(PL_bodytarget, SVt_PVFM);
     sv_setpvn(PL_bodytarget, "", 0);
     PL_formtarget = PL_bodytarget;
@@ -5183,6 +5214,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 STATIC void *
 S_call_list_body(pTHX_ CV *cv)
 {
+    dVAR;
     PUSHMARK(PL_stack_sp);
     call_sv((SV*)cv, G_EVAL|G_DISCARD);
     return NULL;
@@ -5191,6 +5223,7 @@ S_call_list_body(pTHX_ CV *cv)
 void
 Perl_my_exit(pTHX_ U32 status)
 {
+    dVAR;
     DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
                          thr, (unsigned long) status));
     switch (status) {
@@ -5210,6 +5243,7 @@ Perl_my_exit(pTHX_ U32 status)
 void
 Perl_my_failure_exit(pTHX)
 {
+    dVAR;
 #ifdef VMS
      /* We have been called to fall on our sword.  The desired exit code
       * should be already set in STATUS_UNIX, but could be shifted over
@@ -5309,6 +5343,7 @@ S_my_exit_jump(pTHX)
 static I32
 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
+    dVAR;
     const char * const p  = SvPVX_const(PL_e_script);
     const char *nl = strchr(p, '\n');