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 0493dd4..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
@@ -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);
@@ -3397,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
@@ -3407,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)
@@ -3451,6 +3462,7 @@ S_init_interp(pTHX)
 STATIC void
 S_init_main_stash(pTHX)
 {
+    dVAR;
     GV *gv;
 
     PL_curstash = PL_defstash = newHV();
@@ -3580,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");
@@ -3941,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 */
@@ -4208,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
@@ -4277,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();
@@ -4339,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);
@@ -4378,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;
@@ -4406,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));
@@ -4442,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) {
@@ -4460,6 +4480,7 @@ S_nuke_stacks(pTHX)
 STATIC void
 S_init_lexer(pTHX)
 {
+    dVAR;
     PerlIO *tmpfp;
     tmpfp = PL_rsfp;
     PL_rsfp = Nullfp;
@@ -4471,6 +4492,7 @@ S_init_lexer(pTHX)
 STATIC void
 S_init_predump_symbols(pTHX)
 {
+    dVAR;
     GV *tmpgv;
     IO *io;
 
@@ -4503,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);
@@ -4512,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++) {
@@ -4554,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;
@@ -4645,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
@@ -4689,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)
@@ -4789,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;
 }
@@ -4802,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;
 
@@ -4809,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 */
@@ -5072,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;
@@ -5188,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;
@@ -5196,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) {
@@ -5215,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
@@ -5314,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');