This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Add facility to fork() early in perl_destruct and use the child to
[perl5.git] / perl.c
diff --git a/perl.c b/perl.c
index 9c859a4..1d6bc6a 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -92,6 +92,12 @@ char *nw_get_sitelib(const char *pl);
 #include <unistd.h>
 #endif
 
 #include <unistd.h>
 #endif
 
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+#  ifdef I_SYS_WAIT
+#   include <sys/wait.h>
+#  endif
+#endif
+
 #ifdef __BEOS__
 #  define HZ 1000000
 #endif
 #ifdef __BEOS__
 #  define HZ 1000000
 #endif
@@ -125,6 +131,7 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
 static void
 S_init_tls_and_interp(PerlInterpreter *my_perl)
 {
 static void
 S_init_tls_and_interp(PerlInterpreter *my_perl)
 {
+    dVAR;
     if (!PL_curinterp) {                       
        PERL_SET_INTERP(my_perl);
 #if defined(USE_ITHREADS)
     if (!PL_curinterp) {                       
        PERL_SET_INTERP(my_perl);
 #if defined(USE_ITHREADS)
@@ -186,7 +193,7 @@ perl_alloc(void)
     my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
 
     S_init_tls_and_interp(my_perl);
     my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
 
     S_init_tls_and_interp(my_perl);
-    return ZeroD(my_perl, 1, PerlInterpreter);
+    return (PerlInterpreter *) ZeroD(my_perl, 1, PerlInterpreter);
 }
 #endif /* PERL_IMPLICIT_SYS */
 
 }
 #endif /* PERL_IMPLICIT_SYS */
 
@@ -201,6 +208,7 @@ Initializes a new Perl interpreter.  See L<perlembed>.
 void
 perl_construct(pTHXx)
 {
 void
 perl_construct(pTHXx)
 {
+    dVAR;
 #ifdef MULTIPLICITY
     init_interp();
     PL_perl_destruct_level = 1;
 #ifdef MULTIPLICITY
     init_interp();
     PL_perl_destruct_level = 1;
@@ -303,7 +311,9 @@ perl_construct(pTHXx)
 
     /* Use sysconf(_SC_CLK_TCK) if available, if not
      * available or if the sysconf() fails, use the HZ.
 
     /* Use sysconf(_SC_CLK_TCK) if available, if not
      * available or if the sysconf() fails, use the HZ.
-     * BeOS has those, but returns the wrong value. */
+     * BeOS has those, but returns the wrong value.
+     * The HZ if not originally defined has been by now
+     * been defined as CLK_TCK, if available. */
 #if defined(HAS_SYSCONF) && defined(_SC_CLK_TCK) && !defined(__BEOS__)
     PL_clocktick = sysconf(_SC_CLK_TCK);
     if (PL_clocktick <= 0)
 #if defined(HAS_SYSCONF) && defined(_SC_CLK_TCK) && !defined(__BEOS__)
     PL_clocktick = sysconf(_SC_CLK_TCK);
     if (PL_clocktick <= 0)
@@ -319,6 +329,48 @@ perl_construct(pTHXx)
            (int)PERL_SUBVERSION ), 0
     );
 
            (int)PERL_SUBVERSION ), 0
     );
 
+#ifdef HAS_MMAP
+    if (!PL_mmap_page_size) {
+#if defined(HAS_SYSCONF) && (defined(_SC_PAGESIZE) || defined(_SC_MMAP_PAGE_SIZE))
+      {
+       SETERRNO(0, SS_NORMAL);
+#   ifdef _SC_PAGESIZE
+       PL_mmap_page_size = sysconf(_SC_PAGESIZE);
+#   else
+       PL_mmap_page_size = sysconf(_SC_MMAP_PAGE_SIZE);
+#   endif
+       if ((long) PL_mmap_page_size < 0) {
+         if (errno) {
+           SV *error = ERRSV;
+           (void) SvUPGRADE(error, SVt_PV);
+           Perl_croak(aTHX_ "panic: sysconf: %s", SvPV_nolen_const(error));
+         }
+         else
+           Perl_croak(aTHX_ "panic: sysconf: pagesize unknown");
+       }
+      }
+#else
+#   ifdef HAS_GETPAGESIZE
+      PL_mmap_page_size = getpagesize();
+#   else
+#       if defined(I_SYS_PARAM) && defined(PAGESIZE)
+      PL_mmap_page_size = PAGESIZE;       /* compiletime, bad */
+#       endif
+#   endif
+#endif
+      if (PL_mmap_page_size <= 0)
+       Perl_croak(aTHX_ "panic: bad pagesize %" IVdf,
+                  (IV) PL_mmap_page_size);
+    }
+#endif /* HAS_MMAP */
+
+#if defined(HAS_TIMES) && defined(PERL_NEED_TIMESBASE)
+    PL_timesbase.tms_utime  = 0;
+    PL_timesbase.tms_stime  = 0;
+    PL_timesbase.tms_cutime = 0;
+    PL_timesbase.tms_cstime = 0;
+#endif
+
     ENTER;
 }
 
     ENTER;
 }
 
@@ -348,8 +400,13 @@ Shuts down a Perl interpreter.  See L<perlembed>.
 int
 perl_destruct(pTHXx)
 {
 int
 perl_destruct(pTHXx)
 {
+    dVAR;
     volatile int destruct_level;  /* 0=none, 1=full, 2=full with checks */
     HV *hv;
     volatile int destruct_level;  /* 0=none, 1=full, 2=full with checks */
     HV *hv;
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+    int sock;
+    pid_t child;
+#endif
 
     /* wait for all pseudo-forked children to finish */
     PERL_WAIT_FOR_CHILDREN;
 
     /* wait for all pseudo-forked children to finish */
     PERL_WAIT_FOR_CHILDREN;
@@ -357,7 +414,7 @@ perl_destruct(pTHXx)
     destruct_level = PL_perl_destruct_level;
 #ifdef DEBUGGING
     {
     destruct_level = PL_perl_destruct_level;
 #ifdef DEBUGGING
     {
-       char *s;
+       const char *s;
        if ((s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"))) {
             const int i = atoi(s);
            if (destruct_level < i)
        if ((s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"))) {
             const int i = atoi(s);
            if (destruct_level < i)
@@ -366,8 +423,7 @@ perl_destruct(pTHXx)
     }
 #endif
 
     }
 #endif
 
-
-    if(PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
+    if (PL_exit_flags & PERL_EXIT_DESTRUCT_END) {
         dJMPENV;
         int x = 0;
 
         dJMPENV;
         int x = 0;
 
@@ -387,6 +443,66 @@ perl_destruct(pTHXx)
         return STATUS_NATIVE_EXPORT;
     }
 
         return STATUS_NATIVE_EXPORT;
     }
 
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+    if (destruct_level != 0) {
+       /* Fork here to create a child. Our child's job is to preserve the
+          state of scalars prior to destruction, so that we can instruct it
+          to dump any scalars that we later find have leaked.
+          There's no subtlety in this code - it assumes POSIX, and it doesn't
+          fail gracefully  */
+       int fd[2];
+
+       if(socketpair(AF_UNIX, SOCK_STREAM, 0, fd)) {
+           perror("Debug leaking scalars socketpair failed");
+           abort();
+       }
+
+       child = fork();
+       if(child == -1) {
+           perror("Debug leaking scalars fork failed");
+           abort();
+       }
+       if (!child) {
+           /* We are the child */
+           close(fd[0]);
+           sock = fd[1];
+
+           while (1) {
+               SV *target;
+               ssize_t got = read(sock, &target, sizeof(target));
+
+               if(got == 0)
+                   break;
+               if(got < 0) {
+                   perror("Debug leaking scalars child read failed");
+                   abort();
+               }
+               if(got < sizeof(target)) {
+                   perror("Debug leaking scalars child short read");
+                   abort();
+               }
+               sv_dump(target);
+               PerlIO_flush(Perl_debug_log);
+
+               /* Write something back as synchronisation.  */
+               got = write(sock, &target, sizeof(target));
+
+               if(got < 0) {
+                   perror("Debug leaking scalars child write failed");
+                   abort();
+               }
+               if(got < sizeof(target)) {
+                   perror("Debug leaking scalars child short write");
+                   abort();
+               }
+           }
+           _exit(0);
+       }
+       sock = fd[0];
+       close(fd[1]);
+    }
+#endif
+    
     /* We must account for everything.  */
 
     /* Destroy the main CV and syntax tree */
     /* We must account for everything.  */
 
     /* Destroy the main CV and syntax tree */
@@ -490,7 +606,6 @@ perl_destruct(pTHXx)
 
         while (i) {
             SV *resv = ary[--i];
 
         while (i) {
             SV *resv = ary[--i];
-            REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
 
             if (SvFLAGS(resv) & SVf_BREAK) {
                 /* this is PL_reg_curpm, already freed
 
             if (SvFLAGS(resv) & SVf_BREAK) {
                 /* this is PL_reg_curpm, already freed
@@ -501,7 +616,8 @@ perl_destruct(pTHXx)
            else if(SvREPADTMP(resv)) {
              SvREPADTMP_off(resv);
            }
            else if(SvREPADTMP(resv)) {
              SvREPADTMP_off(resv);
            }
-            else {
+            else if(SvIOKp(resv)) {
+               REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
                 ReREFCNT_dec(re);
             }
         }
                 ReREFCNT_dec(re);
             }
         }
@@ -757,23 +873,23 @@ perl_destruct(pTHXx)
     {
        /* Yell and reset the HeVAL() slots that are still holding refcounts,
         * so that sv_free() won't fail on them.
     {
        /* Yell and reset the HeVAL() slots that are still holding refcounts,
         * so that sv_free() won't fail on them.
+        * Now that the global string table is using a single hunk of memory
+        * for both HE and HEK, we either need to explicitly unshare it the
+        * correct way, or actually free things here.
         */
         */
-       I32 riter;
-       I32 max;
-       HE *hent;
-       HE **array;
-
-       riter = 0;
-       max = HvMAX(PL_strtab);
-       array = HvARRAY(PL_strtab);
-       hent = array[0];
+       I32 riter = 0;
+       const I32 max = HvMAX(PL_strtab);
+       HE **array = HvARRAY(PL_strtab);
+       HE *hent = array[0];
+
        for (;;) {
            if (hent && ckWARN_d(WARN_INTERNAL)) {
        for (;;) {
            if (hent && ckWARN_d(WARN_INTERNAL)) {
+               HE *next = HeNEXT(hent);
                Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
                     "Unbalanced string table refcount: (%d) for \"%s\"",
                     HeVAL(hent) - Nullsv, HeKEY(hent));
                Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
                     "Unbalanced string table refcount: (%d) for \"%s\"",
                     HeVAL(hent) - Nullsv, HeKEY(hent));
-               HeVAL(hent) = Nullsv;
-               hent = HeNEXT(hent);
+               Safefree(hent);
+               hent = next;
            }
            if (!hent) {
                if (++riter > max)
            }
            if (!hent) {
                if (++riter > max)
@@ -781,11 +897,16 @@ perl_destruct(pTHXx)
                hent = array[riter];
            }
        }
                hent = array[riter];
            }
        }
+
+       Safefree(array);
+       HvARRAY(PL_strtab) = 0;
+       HvTOTALKEYS(PL_strtab) = 0;
+       HvFILL(PL_strtab) = 0;
     }
     SvREFCNT_dec(PL_strtab);
 
 #ifdef USE_ITHREADS
     }
     SvREFCNT_dec(PL_strtab);
 
 #ifdef USE_ITHREADS
-    /* free the pointer table used for cloning */
+    /* free the pointer tables used for cloning */
     ptr_table_free(PL_ptr_table);
     PL_ptr_table = (PTR_TBL_t*)NULL;
 #endif
     ptr_table_free(PL_ptr_table);
     PL_ptr_table = (PTR_TBL_t*)NULL;
 #endif
@@ -825,8 +946,13 @@ perl_destruct(pTHXx)
            svend = &sva[SvREFCNT(sva)];
            for (sv = sva + 1; sv < svend; ++sv) {
                if (SvTYPE(sv) != SVTYPEMASK) {
            svend = &sva[SvREFCNT(sva)];
            for (sv = sva + 1; sv < svend; ++sv) {
                if (SvTYPE(sv) != SVTYPEMASK) {
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+                   ssize_t got;
+                   SV *target;
+#endif
+
                    PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
                    PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
-                       " flags=0x08%"UVxf
+                       " flags=0x%"UVxf
                        " refcnt=%"UVuf pTHX__FORMAT "\n"
                        "\tallocated at %s:%d %s %s%s\n",
                        sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE,
                        " refcnt=%"UVuf pTHX__FORMAT "\n"
                        "\tallocated at %s:%d %s %s%s\n",
                        sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE,
@@ -837,10 +963,53 @@ perl_destruct(pTHXx)
                            PL_op_name[sv->sv_debug_optype]: "(none)",
                        sv->sv_debug_cloned ? " (cloned)" : ""
                    );
                            PL_op_name[sv->sv_debug_optype]: "(none)",
                        sv->sv_debug_cloned ? " (cloned)" : ""
                    );
+
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+                   PerlIO_flush(Perl_debug_log);
+
+                   got = write(sock, &sv, sizeof(sv));
+
+                   if(got < 0) {
+                       perror("Debug leaking scalars parent write failed");
+                       abort();
+                   }
+                   if(got < sizeof(target)) {
+                       perror("Debug leaking scalars parent short write");
+                       abort();
+                   }
+
+                   got = read(sock, &target, sizeof(target));
+
+                   if(got < 0) {
+                       perror("Debug leaking scalars parent read failed");
+                       abort();
+                   }
+                   if(got < sizeof(target)) {
+                       perror("Debug leaking scalars parent short read");
+                       abort();
+                   }
+#endif
                }
            }
        }
     }
                }
            }
        }
     }
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+    {
+       int status;
+       fd_set rset;
+       /* Wait for up to 4 seconds for child to terminate.
+          This seems to be the least effort way of timing out on reaping
+          its exit status.  */
+       struct timeval waitfor = {4, 0};
+
+       shutdown(sock, 1);
+       FD_ZERO(&rset);
+       FD_SET(sock, &rset);
+       select(sock + 1, &rset, NULL, NULL, &waitfor);
+       waitpid(child, &status, WNOHANG);
+       close(sock);
+    }
+#endif
 #endif
     PL_sv_count = 0;
 
 #endif
     PL_sv_count = 0;
 
@@ -876,8 +1045,6 @@ perl_destruct(pTHXx)
     Safefree(PL_psig_pend);
     PL_psig_pend = (int*)NULL;
     PL_formfeed = Nullsv;
     Safefree(PL_psig_pend);
     PL_psig_pend = (int*)NULL;
     PL_formfeed = Nullsv;
-    Safefree(PL_ofmt);
-    PL_ofmt = Nullch;
     nuke_stacks();
     PL_tainting = FALSE;
     PL_taint_warn = FALSE;
     nuke_stacks();
     PL_tainting = FALSE;
     PL_taint_warn = FALSE;
@@ -895,21 +1062,21 @@ perl_destruct(pTHXx)
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
+       /* we know that type == SVt_PVMG */
+
        /* it could have accumulated taint magic */
        /* it could have accumulated taint magic */
-       if (SvTYPE(PL_mess_sv) >= SVt_PVMG) {
-           MAGIC* mg;
-           MAGIC* moremagic;
-           for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
-               moremagic = mg->mg_moremagic;
-               if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
-                                               && mg->mg_len >= 0)
-                   Safefree(mg->mg_ptr);
-               Safefree(mg);
-           }
+       MAGIC* mg;
+       MAGIC* moremagic;
+       for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) {
+           moremagic = mg->mg_moremagic;
+           if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global
+               && mg->mg_len >= 0)
+               Safefree(mg->mg_ptr);
+           Safefree(mg);
        }
        }
+
        /* we know that type >= SVt_PV */
        /* we know that type >= SVt_PV */
-       SvOOK_off(PL_mess_sv);
-       Safefree(SvPVX(PL_mess_sv));
+       SvPV_free(PL_mess_sv);
        Safefree(SvANY(PL_mess_sv));
        Safefree(PL_mess_sv);
        PL_mess_sv = Nullsv;
        Safefree(SvANY(PL_mess_sv));
        Safefree(PL_mess_sv);
        PL_mess_sv = Nullsv;
@@ -953,20 +1120,17 @@ 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 */
 
 /* 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) && !defined(__GNUC__)
+#if defined(__hpux) && __ux_version > 1020 && !defined(__GNUC__)
 #pragma fini "perl_fini"
 #endif
 
 #pragma fini "perl_fini"
 #endif
 
-#if defined(__GNUC__) && defined(__attribute__) 
-/* want to make sure __attribute__ works here even
- * for -Dd_attribut=undef builds.
- */
-#undef __attribute__
+static void
+#if defined(__GNUC__)
+__attribute__((destructor))
 #endif
 #endif
-
-static void __attribute__((destructor))
-perl_fini()
+perl_fini(void)
 {
 {
+    dVAR;
     if (PL_curinterp)
        FREE_THREAD_KEY;
 }
     if (PL_curinterp)
        FREE_THREAD_KEY;
 }
@@ -1045,6 +1209,7 @@ Tells a Perl interpreter to parse a Perl script.  See L<perlembed>.
 int
 perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
 {
 int
 perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
 {
+    dVAR;
     I32 oldscope;
     int ret;
     dJMPENV;
     I32 oldscope;
     int ret;
     dJMPENV;
@@ -1229,6 +1394,7 @@ setuid perl scripts securely.\n");
 STATIC void *
 S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 {
 STATIC void *
 S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 {
+    dVAR;
     int argc = PL_origargc;
     char **argv = PL_origargv;
     const char *scriptname = NULL;
     int argc = PL_origargc;
     char **argv = PL_origargv;
     const char *scriptname = NULL;
@@ -1237,7 +1403,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     register SV *sv;
     register char *s;
     const char *cddir = Nullch;
     register SV *sv;
     register char *s;
     const char *cddir = Nullch;
+#ifdef USE_SITECUSTOMIZE
     bool minus_f = FALSE;
     bool minus_f = FALSE;
+#endif
 
     PL_fdscript = -1;
     PL_suidscript = -1;
 
     PL_fdscript = -1;
     PL_suidscript = -1;
@@ -1332,7 +1500,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
            break;
 
        case 'f':
            break;
 
        case 'f':
+#ifdef USE_SITECUSTOMIZE
            minus_f = TRUE;
            minus_f = TRUE;
+#endif
            s++;
            goto reswitch;
 
            s++;
            goto reswitch;
 
@@ -1663,10 +1833,13 @@ print \"  \\@INC:\\n    @INC\\n\";");
     if (!PL_do_undump)
        init_postdump_symbols(argc,argv,env);
 
     if (!PL_do_undump)
        init_postdump_symbols(argc,argv,env);
 
-    /* PL_unicode is turned on by -C or by $ENV{PERL_UNICODE}.
-     * PL_utf8locale is conditionally turned on by
+    /* PL_unicode is turned on by -C, or by $ENV{PERL_UNICODE},
+     * or explicitly in some platforms.
      * locale.c:Perl_init_i18nl10n() if the environment
      * look like the user wants to use UTF-8. */
      * locale.c:Perl_init_i18nl10n() if the environment
      * look like the user wants to use UTF-8. */
+#if defined(SYMBIAN)
+    PL_unicode = PERL_UNICODE_STD_FLAG; /* See PERL_SYMBIAN_CONSOLE_UTF8. */
+#endif
     if (PL_unicode) {
         /* Requires init_predump_symbols(). */
         if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) {
     if (PL_unicode) {
         /* Requires init_predump_symbols(). */
         if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) {
@@ -1869,7 +2042,6 @@ S_run_body(pTHX_ I32 oldscope)
        PL_op = PL_main_start;
        CALLRUNOPS(aTHX);
     }
        PL_op = PL_main_start;
        CALLRUNOPS(aTHX);
     }
-
     my_exit(0);
     /* NOTREACHED */
 }
     my_exit(0);
     /* NOTREACHED */
 }
@@ -2059,7 +2231,7 @@ I32
 Perl_call_sv(pTHX_ SV *sv, I32 flags)
                        /* See G_* flags in cop.h */
 {
 Perl_call_sv(pTHX_ SV *sv, I32 flags)
                        /* See G_* flags in cop.h */
 {
-    dSP;
+    dVAR; dSP;
     LOGOP myop;                /* fake syntax tree node */
     UNOP method_op;
     I32 oldmark;
     LOGOP myop;                /* fake syntax tree node */
     UNOP method_op;
     I32 oldmark;
@@ -2119,7 +2291,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
        /* we're trying to emulate pp_entertry() here */
        {
            register PERL_CONTEXT *cx;
        /* we're trying to emulate pp_entertry() here */
        {
            register PERL_CONTEXT *cx;
-           I32 gimme = GIMME_V;
+           const I32 gimme = GIMME_V;
        
            ENTER;
            SAVETMPS;
        
            ENTER;
            SAVETMPS;
@@ -2132,7 +2304,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
            if (flags & G_KEEPERR)
                PL_in_eval |= EVAL_KEEPERR;
            else
            if (flags & G_KEEPERR)
                PL_in_eval |= EVAL_KEEPERR;
            else
-               sv_setpv(ERRSV,"");
+               sv_setpvn(ERRSV,"",0);
        }
        PL_markstack_ptr++;
 
        }
        PL_markstack_ptr++;
 
@@ -2143,7 +2315,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
            call_body((OP*)&myop, FALSE);
            retval = PL_stack_sp - (PL_stack_base + oldmark);
            if (!(flags & G_KEEPERR))
            call_body((OP*)&myop, FALSE);
            retval = PL_stack_sp - (PL_stack_base + oldmark);
            if (!(flags & G_KEEPERR))
-               sv_setpv(ERRSV,"");
+               sv_setpvn(ERRSV,"",0);
            break;
        case 1:
            STATUS_ALL_FAILURE;
            break;
        case 1:
            STATUS_ALL_FAILURE;
@@ -2230,7 +2402,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;
     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;
     int ret;
     OP* oldop = PL_op;
     dJMPENV;
@@ -2245,7 +2416,6 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     Zero(PL_op, 1, UNOP);
     EXTEND(PL_stack_sp, 1);
     *++PL_stack_sp = sv;
     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;
 
     if (!(flags & G_NOARGS))
        myop.op_flags = OPf_STACKED;
@@ -2268,7 +2438,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        call_body((OP*)&myop,TRUE);
        retval = PL_stack_sp - (PL_stack_base + oldmark);
        if (!(flags & G_KEEPERR))
        call_body((OP*)&myop,TRUE);
        retval = PL_stack_sp - (PL_stack_base + oldmark);
        if (!(flags & G_KEEPERR))
-           sv_setpv(ERRSV,"");
+           sv_setpvn(ERRSV,"",0);
        break;
     case 1:
        STATUS_ALL_FAILURE;
        break;
     case 1:
        STATUS_ALL_FAILURE;
@@ -2331,8 +2501,7 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
     PUTBACK;
 
     if (croak_on_error && SvTRUE(ERRSV)) {
     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;
     }
 
     return sv;
@@ -2382,39 +2551,40 @@ S_usage(pTHX_ const char *name)         /* XXX move this out into a module ? */
     /* This message really ought to be max 23 lines.
      * Removed -h because the user already knows that option. Others? */
 
     /* This message really ought to be max 23 lines.
      * Removed -h because the user already knows that option. Others? */
 
-    static const char *usage_msg[] = {
-"-0[octal]       specify record separator (\\0, if no argument)",
-"-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",
+    static const char * const usage_msg[] = {
+"-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
 };
 "\n",
 NULL
 };
-    const char **p = usage_msg;
+    const char * const *p = usage_msg;
 
     PerlIO_printf(PerlIO_stdout(),
                  "\nUsage: %s [switches] [--] [programfile] [arguments]",
 
     PerlIO_printf(PerlIO_stdout(),
                  "\nUsage: %s [switches] [--] [programfile] [arguments]",
@@ -2430,7 +2600,7 @@ NULL
 int
 Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 {
 int
 Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 {
-    static const char *usage_msgd[] = {
+    static const char * const usage_msgd[] = {
       " Debugging flag values: (see also -d)",
       "  p  Tokenizing and parsing (with v, displays parse stack)",
       "  s  Stack snapshots (with v, displays all stacks)",
       " Debugging flag values: (see also -d)",
       "  p  Tokenizing and parsing (with v, displays parse stack)",
       "  s  Stack snapshots (with v, displays all stacks)",
@@ -2476,7 +2646,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
        for (; isALNUM(**s); (*s)++) ;
     }
     else if (givehelp) {
        for (; isALNUM(**s); (*s)++) ;
     }
     else if (givehelp) {
-      const char **p = usage_msgd;
+      char **p = (char **)usage_msgd;
       while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
     }
 #  ifdef EBCDIC
       while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
     }
 #  ifdef EBCDIC
@@ -2493,20 +2663,22 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 char *
 Perl_moreswitches(pTHX_ char *s)
 {
 char *
 Perl_moreswitches(pTHX_ char *s)
 {
-    STRLEN numlen;
+    dVAR;
     UV rschar;
 
     switch (*s) {
     case '0':
     {
         I32 flags = 0;
     UV rschar;
 
     switch (*s) {
     case '0':
     {
         I32 flags = 0;
+        STRLEN numlen;
 
         SvREFCNT_dec(PL_rs);
         if (s[1] == 'x' && s[2]) {
 
         SvREFCNT_dec(PL_rs);
         if (s[1] == 'x' && s[2]) {
-             char *e;
+             const char *e = s+=2;
              U8 *tmps;
 
              U8 *tmps;
 
-             for (s += 2, e = s; *e; e++);
+             while (*e)
+               e++;
              numlen = e - s;
              flags = PERL_SCAN_SILENT_ILLDIGIT;
              rschar = (U32)grok_hex(s, &numlen, &flags, NULL);
              numlen = e - s;
              flags = PERL_SCAN_SILENT_ILLDIGIT;
              rschar = (U32)grok_hex(s, &numlen, &flags, NULL);
@@ -2603,7 +2775,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
                   "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':
        return s;
     }  
     case 'h':
@@ -2619,8 +2790,8 @@ Perl_moreswitches(pTHX_ char *s)
        }
 #endif /* __CYGWIN__ */
        PL_inplace = savepv(s+1);
        }
 #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. */
        if (*s) {
            *s++ = '\0';
            if (*s == '-')      /* Additional switches on #! line. */
@@ -2661,6 +2832,7 @@ Perl_moreswitches(pTHX_ char *s)
        }
        if (isDIGIT(*s)) {
             I32 flags = 0;
        }
        if (isDIGIT(*s)) {
             I32 flags = 0;
+           STRLEN numlen;
            PL_ors_sv = newSVpvn("\n",1);
            numlen = 3 + (*s == '0');
            *SvPVX(PL_ors_sv) = (char)grok_oct(s, &numlen, &flags, NULL);
            PL_ors_sv = newSVpvn("\n",1);
            numlen = 3 + (*s == '0');
            *SvPVX(PL_ors_sv) = (char)grok_oct(s, &numlen, &flags, NULL);
@@ -2679,17 +2851,27 @@ Perl_moreswitches(pTHX_ char *s)
        forbid_setid("-A");
        if (!PL_preambleav)
            PL_preambleav = newAV();
        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);
            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 */
     case 'M':
        forbid_setid("-M");     /* XXX ? */
        /* FALL THROUGH */
@@ -2769,13 +2951,13 @@ Perl_moreswitches(pTHX_ char *s)
                (void *)upg_version(PL_patchlevel);
 #if !defined(DGUX)
        PerlIO_printf(PerlIO_stdout(),
                (void *)upg_version(PL_patchlevel);
 #if !defined(DGUX)
        PerlIO_printf(PerlIO_stdout(),
-               Perl_form(aTHX_ "\nThis is perl, v%"SVf" built for %s",
+               Perl_form(aTHX_ "\nThis is perl, %"SVf" built for %s",
                    vstringify(PL_patchlevel),
                    ARCHNAME));
 #else /* DGUX */
 /* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */
        PerlIO_printf(PerlIO_stdout(),
                    vstringify(PL_patchlevel),
                    ARCHNAME));
 #else /* DGUX */
 /* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */
        PerlIO_printf(PerlIO_stdout(),
-               Perl_form(aTHX_ "\nThis is perl, v%"SVf"\n",
+               Perl_form(aTHX_ "\nThis is perl, %"SVf"\n",
                    vstringify(PL_patchlevel)));
        PerlIO_printf(PerlIO_stdout(),
                        Perl_form(aTHX_ "        built under %s at %s %s\n",
                    vstringify(PL_patchlevel)));
        PerlIO_printf(PerlIO_stdout(),
                        Perl_form(aTHX_ "        built under %s at %s %s\n",
@@ -2856,6 +3038,10 @@ Perl_moreswitches(pTHX_ char *s)
        PerlIO_printf(PerlIO_stdout(),"Built on " __DATE__ " " __TIME__ "\n\n");
        wce_hitreturn();
 #endif
        PerlIO_printf(PerlIO_stdout(),"Built on " __DATE__ " " __TIME__ "\n\n");
        wce_hitreturn();
 #endif
+#ifdef SYMBIAN
+       PerlIO_printf(PerlIO_stdout(),
+                     "Symbian port by Nokia, 2004-2005\n");
+#endif
 #ifdef BINARY_BUILD_NOTICE
        BINARY_BUILD_NOTICE;
 #endif
 #ifdef BINARY_BUILD_NOTICE
        BINARY_BUILD_NOTICE;
 #endif
@@ -2864,7 +3050,7 @@ Perl_moreswitches(pTHX_ char *s)
 Perl may be copied only under the terms of either the Artistic License or the\n\
 GNU General Public License, which may be found in the Perl 5 source kit.\n\n\
 Complete documentation for Perl, including FAQ lists, should be found on\n\
 Perl may be copied only under the terms of either the Artistic License or the\n\
 GNU General Public License, which may be found in the Perl 5 source kit.\n\n\
 Complete documentation for Perl, including FAQ lists, should be found on\n\
-this system using `man perl' or `perldoc perl'.  If you have access to the\n\
+this system using \"man perl\" or \"perldoc perl\".  If you have access to the\n\
 Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
        my_exit(0);
     case 'w':
 Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
        my_exit(0);
     case 'w':
@@ -2956,7 +3142,7 @@ S_init_interp(pTHX)
 #  if defined(PERL_IMPLICIT_CONTEXT)
 #    if defined(USE_5005THREADS)
 #      define PERLVARI(var,type,init)          PERL_GET_INTERP->var = init;
 #  if defined(PERL_IMPLICIT_CONTEXT)
 #    if defined(USE_5005THREADS)
 #      define PERLVARI(var,type,init)          PERL_GET_INTERP->var = init;
-#      define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
+#      define PERLVARIC(var,type,init)         PERL_GET_INTERP->var = init;
 #    else /* !USE_5005THREADS */
 #      define PERLVARI(var,type,init)          aTHX->var = init;
 #      define PERLVARIC(var,type,init) aTHX->var = init;
 #    else /* !USE_5005THREADS */
 #      define PERLVARI(var,type,init)          aTHX->var = init;
 #      define PERLVARIC(var,type,init) aTHX->var = init;
@@ -3001,7 +3187,7 @@ S_init_main_stash(pTHX)
     SvREFCNT_dec(GvHV(gv));
     GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
     SvREADONLY_on(gv);
     SvREFCNT_dec(GvHV(gv));
     GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
     SvREADONLY_on(gv);
-    HvNAME(PL_defstash) = savepvn("main", 4);
+    Perl_hv_name_set(aTHX_ PL_defstash, "main", 4, 0);
     PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(PL_incgv);
     PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
     PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(PL_incgv);
     PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
@@ -3032,6 +3218,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
     const char *cpp_discard_flag;
     const char *perl;
 #endif
     const char *cpp_discard_flag;
     const char *perl;
 #endif
+    dVAR;
 
     PL_fdscript = -1;
     PL_suidscript = -1;
 
     PL_fdscript = -1;
     PL_suidscript = -1;
@@ -3123,7 +3310,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",
 
        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 = "\"";
 
 #       if defined(MSDOS) || defined(WIN32) || defined(VMS)
             quote = "\"";
@@ -3164,9 +3352,9 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 
         DEBUG_P(PerlIO_printf(Perl_debug_log,
                               "PL_preprocess: cmd=\"%s\"\n",
 
         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);
     }
        SvREFCNT_dec(cmd);
        SvREFCNT_dec(cpp);
     }
@@ -3328,6 +3516,7 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
 STATIC void
 S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
 {
 STATIC void
 S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
 {
+    dVAR;
 #ifdef IAMSUID
     /* int which; */
 #endif /* IAMSUID */
 #ifdef IAMSUID
     /* int which; */
 #endif /* IAMSUID */
@@ -3360,13 +3549,13 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
      */
 
 #ifdef DOSUID
      */
 
 #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;
 
     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)
 
 #ifdef IAMSUID
        if (PL_fdscript < 0 || PL_suidscript != 1)
@@ -3464,10 +3653,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);
        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 ||
        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");
            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)
        /* PSz 27 Feb 04 */
        /* Sanity check on line length */
        if (strlen(s) < 1 || strlen(s) > 4000)
@@ -3476,12 +3667,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++;
        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 */
                       (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++;
        /*
            Perl_croak(aTHX_ "Not a perl script");
        while (*s == ' ' || *s == '\t') s++;
        /*
@@ -3771,7 +3962,6 @@ S_find_beginning(pTHX)
                while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
                       || s2[-1] == '_') s2--;
                if (strnEQ(s2-4,"perl",4))
                while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
                       || s2[-1] == '_') s2--;
                if (strnEQ(s2-4,"perl",4))
-                   /*SUPPRESS 530*/
                    while ((s = moreswitches(s)))
                        ;
            }
                    while ((s = moreswitches(s)))
                        ;
            }
@@ -3906,7 +4096,6 @@ Perl_init_debugger(pTHX)
     PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
     PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
     PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
     PL_DBgv = gv_fetchpv("DB::DB", GV_ADDMULTI, SVt_PVGV);
     PL_DBline = gv_fetchpv("DB::dbline", GV_ADDMULTI, SVt_PVAV);
     PL_DBsub = gv_HVadd(gv_fetchpv("DB::sub", GV_ADDMULTI, SVt_PVHV));
-    sv_upgrade(GvSV(PL_DBsub), SVt_IV);        /* IVX accessed if PERLDB_SUB_NN */
     PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsingle, 0);
     PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
     PL_DBsingle = GvSV((gv_fetchpv("DB::single", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsingle, 0);
     PL_DBtrace = GvSV((gv_fetchpv("DB::trace", GV_ADDMULTI, SVt_PV)));
@@ -4072,8 +4261,7 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
 STATIC void
 S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
 {
 STATIC void
 S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
 {
-    char *s;
-    SV *sv;
+    dVAR;
     GV* tmpgv;
 
     PL_toptarget = NEWSV(0,0);
     GV* tmpgv;
 
     PL_toptarget = NEWSV(0,0);
@@ -4121,6 +4309,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
        }
        if (env) {
           char** origenv = environ;
        }
        if (env) {
           char** origenv = environ;
+         char *s;
+         SV *sv;
          for (; *env; env++) {
            if (!(s = strchr(*env,'=')) || s == *env)
                continue;
          for (; *env; env++) {
            if (!(s = strchr(*env,'=')) || s == *env)
                continue;
@@ -4277,7 +4467,7 @@ S_init_perllib(pTHX)
 #endif /* MACOS_TRADITIONAL */
 }
 
 #endif /* MACOS_TRADITIONAL */
 }
 
-#if defined(DOSISH) || defined(EPOC)
+#if defined(DOSISH) || defined(EPOC) || defined(SYMBIAN)
 #    define PERLLIB_SEP ';'
 #else
 #  if defined(VMS)
 #    define PERLLIB_SEP ';'
 #else
 #  if defined(VMS)
@@ -4301,7 +4491,7 @@ STATIC SV *
 S_incpush_if_exists(pTHX_ SV *dir)
 {
     Stat_t tmpstatbuf;
 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);
        S_ISDIR(tmpstatbuf.st_mode)) {
        av_push(GvAVn(PL_incgv), dir);
        dir = NEWSV(0,0);
@@ -4551,7 +4741,7 @@ S_init_main_thread(pTHX)
     SvFLAGS(PL_thrsv) = SVt_PV;
     SvANY(PL_thrsv) = (void*)xpv;
     SvREFCNT(PL_thrsv) = 1 << 30;      /* practically infinite */
     SvFLAGS(PL_thrsv) = SVt_PV;
     SvANY(PL_thrsv) = (void*)xpv;
     SvREFCNT(PL_thrsv) = 1 << 30;      /* practically infinite */
-    SvPVX(PL_thrsv) = (char*)thr;
+    SvPV_set(PL_thrsvr, (char*)thr);
     SvCUR_set(PL_thrsv, sizeof(thr));
     SvLEN_set(PL_thrsv, sizeof(thr));
     *SvEND(PL_thrsv) = '\0';   /* in the trailing_nul field */
     SvCUR_set(PL_thrsv, sizeof(thr));
     SvLEN_set(PL_thrsv, sizeof(thr));
     *SvEND(PL_thrsv) = '\0';   /* in the trailing_nul field */
@@ -4610,6 +4800,7 @@ S_init_main_thread(pTHX)
 void
 Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 {
 void
 Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 {
+    dVAR;
     SV *atsv;
     const line_t oldline = CopLINE(PL_curcop);
     CV *cv;
     SV *atsv;
     const line_t oldline = CopLINE(PL_curcop);
     CV *cv;
@@ -4640,7 +4831,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
        case 0:
            call_list_body(cv);
            atsv = ERRSV;
        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);
            if (len) {
                PL_curcop = &PL_compiling;
                CopLINE_set(PL_curcop, oldline);
@@ -4739,13 +4930,13 @@ Perl_my_failure_exit(pTHX)
 #else
     int exitstatus;
     if (errno & 255)
 #else
     int exitstatus;
     if (errno & 255)
-       STATUS_POSIX_SET(errno);
+       STATUS_UNIX_SET(errno);
     else {
     else {
-       exitstatus = STATUS_POSIX >> 8;
+       exitstatus = STATUS_UNIX >> 8;
        if (exitstatus & 255)
        if (exitstatus & 255)
-           STATUS_POSIX_SET(exitstatus);
+           STATUS_UNIX_SET(exitstatus);
        else
        else
-           STATUS_POSIX_SET(255);
+           STATUS_UNIX_SET(255);
     }
 #endif
     my_exit_jump();
     }
 #endif
     my_exit_jump();
@@ -4754,6 +4945,7 @@ Perl_my_failure_exit(pTHX)
 STATIC void
 S_my_exit_jump(pTHX)
 {
 STATIC void
 S_my_exit_jump(pTHX)
 {
+    dVAR;
     register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
     register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
@@ -4777,11 +4969,11 @@ S_my_exit_jump(pTHX)
 static I32
 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
 static I32
 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
-    char *p, *nl;
+    const char *p, *nl;
     (void)idx;
     (void)maxlen;
 
     (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) {
     nl = strchr(p, '\n');
     nl = (nl) ? nl+1 : SvEND(PL_e_script);
     if (nl-p == 0) {
@@ -4792,3 +4984,13 @@ read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
     sv_chop(PL_e_script, nl);
     return 1;
 }
     sv_chop(PL_e_script, nl);
     return 1;
 }
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
Unnamed repository; edit this file 'description' to name the repository.