X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=9468e6b4dee1ba6f521160b0e6fca1aee98824de;hb=a28509cc00517ad2ad1f6e022f1be6ab8f1ad18e;hp=ca781771a3b9927503dba2c69414fa3f2cc5dd49;hpb=e1ec3a884f8d8c64eb7e391b2a363f47cbeed570;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index ca78177..9468e6b 100644
--- a/util.c
+++ b/util.c
@@ -30,6 +30,11 @@
 #endif
 #endif
 
+#ifdef __Lynx__
+/* Missing protos on LynxOS */
+int putenv(char *);
+#endif
+
 #ifdef I_SYS_WAIT
 #  include <sys/wait.h>
 #endif
@@ -141,6 +146,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size)
 Free_t
 Perl_safesysfree(Malloc_t where)
 {
+    dVAR;
 #ifdef PERL_IMPLICIT_SYS
     dTHX;
 #endif
@@ -246,7 +252,7 @@ Perl_delimcpy(pTHX_ register char *to, register const char *toend, register cons
     if (to < toend)
 	*to = '\0';
     *retlen = tolen;
-    return from;
+    return (char *)from;
 }
 
 /* return ptr to little string in big string, NULL if not found */
@@ -255,7 +261,6 @@ Perl_delimcpy(pTHX_ register char *to, register const char *toend, register cons
 char *
 Perl_instr(pTHX_ register const char *big, register const char *little)
 {
-    register const char *s, *x;
     register I32 first;
 
     if (!little)
@@ -264,6 +269,7 @@ Perl_instr(pTHX_ register const char *big, register const char *little)
     if (!first)
 	return (char*)big;
     while (*big) {
+	register const char *s, *x;
 	if (*big++ != first)
 	    continue;
 	for (x=big,s=little; *s; /**/ ) {
@@ -285,7 +291,6 @@ Perl_instr(pTHX_ register const char *big, register const char *little)
 char *
 Perl_ninstr(pTHX_ register const char *big, register const char *bigend, const char *little, const char *lend)
 {
-    register const char *s, *x;
     register const I32 first = *little;
     register const char *littleend = lend;
 
@@ -295,6 +300,7 @@ Perl_ninstr(pTHX_ register const char *big, register const char *bigend, const c
 	return Nullch;
     bigend -= littleend - little++;
     while (big <= bigend) {
+	register const char *s, *x;
 	if (*big++ != first)
 	    continue;
 	for (x=big,s=little; s < littleend; /**/ ) {
@@ -315,7 +321,6 @@ char *
 Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *little, const char *lend)
 {
     register const char *bigbeg;
-    register const char *s, *x;
     register const I32 first = *little;
     register const char *littleend = lend;
 
@@ -324,6 +329,7 @@ Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *lit
     bigbeg = big;
     big = bigend - (littleend - little++);
     while (big >= bigbeg) {
+	register const char *s, *x;
 	if (*big-- != first)
 	    continue;
 	for (x=big+2,s=little; s < littleend; /**/ ) {
@@ -360,7 +366,7 @@ Analyses the string in order to make fast searches on it using fbm_instr()
 void
 Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
 {
-    register U8 *s;
+    const register U8 *s;
     register U8 *table;
     register U32 i;
     STRLEN len;
@@ -373,20 +379,16 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
 	if (mg && mg->mg_len >= 0)
 	    mg->mg_len++;
     }
-    s = (U8*)SvPV_force(sv, len);
-    (void)SvUPGRADE(sv, SVt_PVBM);
+    s = (U8*)SvPV_force_mutable(sv, len);
+    SvUPGRADE(sv, SVt_PVBM);
     if (len == 0)		/* TAIL might be on a zero-length string. */
 	return;
     if (len > 2) {
-	U8 mlen;
-	unsigned char *sb;
+	const unsigned char *sb;
+	const U8 mlen = (len>255) ? 255 : (U8)len;
 
-	if (len > 255)
-	    mlen = 255;
-	else
-	    mlen = (U8)len;
 	Sv_Grow(sv, len + 256 + FBM_TABLE_OFFSET);
-	table = (unsigned char*)(SvPVX(sv) + len + FBM_TABLE_OFFSET);
+	table = (unsigned char*)(SvPVX_mutable(sv) + len + FBM_TABLE_OFFSET);
 	s = table - 1 - FBM_TABLE_OFFSET;	/* last char */
 	memset((void*)table, mlen, 256);
 	table[-1] = (U8)flags;
@@ -401,7 +403,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     sv_magic(sv, Nullsv, PERL_MAGIC_bm, Nullch, 0);	/* deep magic */
     SvVALID_on(sv);
 
-    s = (unsigned char*)(SvPVX(sv));		/* deeper magic */
+    s = (const unsigned char*)(SvPVX_const(sv));	/* deeper magic */
     for (i = 0; i < len; i++) {
 	if (PL_freq[s[i]] < frequency) {
 	    rarest = i;
@@ -437,7 +439,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 {
     register unsigned char *s;
     STRLEN l;
-    register unsigned char *little = (unsigned char *)SvPV(littlestr,l);
+    register const unsigned char *little
+	= (const unsigned char *)SvPV_const(littlestr,l);
     register STRLEN littlelen = l;
     register const I32 multiline = flags & FBMrf_MULTILINE;
 
@@ -446,7 +449,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 	     && ((STRLEN)(bigend - big) == littlelen - 1)
 	     && (littlelen == 1
 		 || (*big == *little &&
-		     memEQ(big, little, littlelen - 1))))
+		     memEQ((char *)big, (char *)little, littlelen - 1))))
 	    return (char*)big;
 	return Nullch;
     }
@@ -485,8 +488,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 	    /* This should be better than FBM if c1 == c2, and almost
 	       as good otherwise: maybe better since we do less indirection.
 	       And we save a lot of memory by caching no table. */
-	    register unsigned char c1 = little[0];
-	    register unsigned char c2 = little[1];
+	    const unsigned char c1 = little[0];
+	    const unsigned char c2 = little[1];
 
 	    s = big + 1;
 	    bigend--;
@@ -568,7 +571,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 
     {	/* Do actual FBM.  */
 	register const unsigned char *table = little + littlelen + FBM_TABLE_OFFSET;
-	register unsigned char *oldlittle;
+	const register unsigned char *oldlittle;
 
 	if (littlelen > (STRLEN)(bigend - big))
 	    return Nullch;
@@ -588,7 +591,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 		goto check_end;
 	    }
 	    else {		/* less expensive than calling strncmp() */
-		register unsigned char *olds = s;
+		register unsigned char * const olds = s;
 
 		tmp = littlelen;
 
@@ -615,7 +618,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 
 /* start_shift, end_shift are positive quantities which give offsets
    of ends of some substring of bigstr.
-   If `last' we want the last occurrence.
+   If "last" we want the last occurrence.
    old_posp is the way of communication between consequent calls if
    the next call needs to find the .
    The initial *old_posp should be -1.
@@ -631,7 +634,6 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 char *
 Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
 {
-    register unsigned char *s, *x;
     register unsigned char *big;
     register I32 pos;
     register I32 previous;
@@ -680,6 +682,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
     }
     big -= previous;
     do {
+	register unsigned char *s, *x;
 	if (pos >= stop_pos) break;
 	if (big[pos] != first)
 	    continue;
@@ -729,6 +732,7 @@ Perl_ibcmp(pTHX_ const char *s1, const char *s2, register I32 len)
 I32
 Perl_ibcmp_locale(pTHX_ const char *s1, const char *s2, register I32 len)
 {
+    dVAR;
     register const U8 *a = (const U8 *)s1;
     register const U8 *b = (const U8 *)s2;
     while (len--) {
@@ -757,20 +761,15 @@ be freed with the C<Safefree()> function.
 char *
 Perl_savepv(pTHX_ const char *pv)
 {
-    register char *newaddr;
-#ifdef PERL_MALLOC_WRAP
-    STRLEN pvlen;
-#endif
     if (!pv)
 	return Nullch;
+    else {
+	char *newaddr;
+	const STRLEN pvlen = strlen(pv)+1;
+	New(902,newaddr,pvlen,char);
+	return strcpy(newaddr,pv);
+    }
 
-#ifdef PERL_MALLOC_WRAP
-    pvlen = strlen(pv)+1;
-    New(902,newaddr,pvlen,char);
-#else
-    New(902,newaddr,strlen(pv)+1,char);
-#endif
-    return strcpy(newaddr,pv);
 }
 
 /* same thing but with a known length */
@@ -796,10 +795,10 @@ Perl_savepvn(pTHX_ const char *pv, register I32 len)
     if (pv) {
 	/* might not be null terminated */
     	newaddr[len] = '\0';
-    	return CopyD(pv,newaddr,len,char);
+    	return (char *) CopyD(pv,newaddr,len,char);
     }
     else {
-	return ZeroD(newaddr,len+1,char);
+	return (char *) ZeroD(newaddr,len+1,char);
     }
 }
 
@@ -840,12 +839,12 @@ char *
 Perl_savesvpv(pTHX_ SV *sv)
 {
     STRLEN len;
-    const char *pv = SvPV(sv, len);
+    const char *pv = SvPV_const(sv, len);
     register char *newaddr;
 
     ++len;
     New(903,newaddr,len,char);
-    return CopyD(pv,newaddr,len,char);
+    return (char *) CopyD(pv,newaddr,len,char);
 }
 
 
@@ -868,6 +867,7 @@ S_mess_alloc(pTHX)
     Newz(905, any, 1, XPVMG);
     SvFLAGS(sv) = SVt_PVMG;
     SvANY(sv) = (void*)any;
+    SvPV_set(sv, 0);
     SvREFCNT(sv) = 1 << 30; /* practically infinite */
     PL_mess_sv = sv;
     return sv;
@@ -986,7 +986,7 @@ SV *
 Perl_vmess(pTHX_ const char *pat, va_list *args)
 {
     SV *sv = mess_alloc();
-    static char dgd[] = " during global destruction.\n";
+    static const char dgd[] = " during global destruction.\n";
 
     sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
     if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') {
@@ -1006,7 +1006,7 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 	    OutCopFILE(cop), (IV)CopLINE(cop));
 	if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) {
 	    const bool line_mode = (RsSIMPLE(PL_rs) &&
-			      SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n');
+			      SvCUR(PL_rs) == 1 && *SvPVX_const(PL_rs) == '\n');
 	    Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %"IVdf,
 			   PL_last_in_gv == PL_argvgv ?
 			   "" : GvNAME(PL_last_in_gv),
@@ -1021,6 +1021,7 @@ Perl_vmess(pTHX_ const char *pat, va_list *args)
 void
 Perl_write_to_stderr(pTHX_ const char* message, int msglen)
 {
+    dVAR;
     IO *io;
     MAGIC *mg;
 
@@ -1066,39 +1067,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
 
 /* Common code used by vcroak, vdie and vwarner  */
 
-void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8);
-
-char *
-S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
-		    I32* utf8)
-{
-    char *message;
-
-    if (pat) {
-	SV *msv = vmess(pat, args);
-	if (PL_errors && SvCUR(PL_errors)) {
-	    sv_catsv(PL_errors, msv);
-	    message = SvPV(PL_errors, *msglen);
-	    SvCUR_set(PL_errors, 0);
-	}
-	else
-	    message = SvPV(msv,*msglen);
-	*utf8 = SvUTF8(msv);
-    }
-    else {
-	message = Nullch;
-    }
-
-    DEBUG_S(PerlIO_printf(Perl_debug_log,
-			  "%p: die/croak: message = %s\ndiehook = %p\n",
-			  thr, message, PL_diehook));
-    if (PL_diehook) {
-	S_vdie_common(aTHX_ message, *msglen, *utf8);
-    }
-    return message;
-}
-
-void
+STATIC void
 S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8)
 {
     HV *stash;
@@ -1139,10 +1108,41 @@ S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8)
     }
 }
 
+STATIC char *
+S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
+		    I32* utf8)
+{
+    dVAR;
+    char *message;
+
+    if (pat) {
+	SV *msv = vmess(pat, args);
+	if (PL_errors && SvCUR(PL_errors)) {
+	    sv_catsv(PL_errors, msv);
+	    message = SvPV(PL_errors, *msglen);
+	    SvCUR_set(PL_errors, 0);
+	}
+	else
+	    message = SvPV(msv,*msglen);
+	*utf8 = SvUTF8(msv);
+    }
+    else {
+	message = Nullch;
+    }
+
+    DEBUG_S(PerlIO_printf(Perl_debug_log,
+			  "%p: die/croak: message = %s\ndiehook = %p\n",
+			  thr, message, PL_diehook));
+    if (PL_diehook) {
+	S_vdie_common(aTHX_ message, *msglen, *utf8);
+    }
+    return message;
+}
+
 OP *
 Perl_vdie(pTHX_ const char* pat, va_list *args)
 {
-    char *message;
+    const char *message;
     const int was_in_eval = PL_in_eval;
     STRLEN msglen;
     I32 utf8 = 0;
@@ -1191,7 +1191,7 @@ Perl_die(pTHX_ const char* pat, ...)
 void
 Perl_vcroak(pTHX_ const char* pat, va_list *args)
 {
-    char *message;
+    const char *message;
     STRLEN msglen;
     I32 utf8 = 0;
 
@@ -1255,6 +1255,7 @@ Perl_croak(pTHX_ const char *pat, ...)
 void
 Perl_vwarn(pTHX_ const char* pat, va_list *args)
 {
+    dVAR;
     char *message;
     HV *stash;
     GV *gv;
@@ -1334,7 +1335,7 @@ Perl_warn(pTHX_ const char *pat, ...)
 void
 Perl_warner_nocontext(U32 err, const char *pat, ...)
 {
-    dTHX;
+    dTHX; 
     va_list args;
     va_start(args, pat);
     vwarner(err, pat, &args);
@@ -1354,11 +1355,12 @@ Perl_warner(pTHX_ U32  err, const char* pat,...)
 void
 Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 {
+    dVAR;
     if (ckDEAD(err)) {
-	SV *msv = vmess(pat, args);
+	SV * const msv = vmess(pat, args);
 	STRLEN msglen;
 	const char *message = SvPV(msv, msglen);
-	I32 utf8 = SvUTF8(msv);
+	const I32 utf8 = SvUTF8(msv);
 
 	if (PL_diehook) {
 	    assert(message);
@@ -1393,6 +1395,7 @@ Perl_vwarner(pTHX_ U32  err, const char* pat, va_list* args)
 void
 Perl_my_setenv(pTHX_ const char *nam, const char *val)
 {
+  dVAR;
 #ifdef USE_ITHREADS
   /* only parent thread can modify process environment */
   if (PL_curinterp == aTHX)
@@ -1442,7 +1445,7 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
     my_setenv_format(environ[i], nam, nlen, val, vlen);
     } else {
 # endif
-#   if defined(__CYGWIN__) || defined( EPOC)
+#   if defined(__CYGWIN__) || defined(EPOC) || defined(SYMBIAN) 
     setenv(nam, val, 1);
 #   else
     char *new_env;
@@ -1465,8 +1468,9 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
 #else /* WIN32 || NETWARE */
 
 void
-Perl_my_setenv(pTHX_ const char *nam, char *val)
+Perl_my_setenv(pTHX_ const char *nam, const char *val)
 {
+    dVAR;
     register char *envstr;
     const int nlen = strlen(nam);
     int vlen;
@@ -1573,7 +1577,7 @@ Perl_my_memcmp(const char *s1, const char *s2, register I32 len)
     register I32 tmp;
 
     while (len--) {
-	if (tmp = *a++ - *b++)
+        if ((tmp = *a++ - *b++))
 	    return tmp;
     }
     return 0;
@@ -2025,8 +2029,8 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
     LOCK_FDPID_MUTEX;
     sv = *av_fetch(PL_fdpid,p[This],TRUE);
     UNLOCK_FDPID_MUTEX;
-    (void)SvUPGRADE(sv,SVt_IV);
-    SvIVX(sv) = pid;
+    SvUPGRADE(sv,SVt_IV);
+    SvIV_set(sv, pid);
     PL_forkprocess = pid;
     /* If we managed to get status pipe check for exec fail */
     if (did_pipes && pid > 0) {
@@ -2131,8 +2135,6 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 #ifndef OS2
 	if (doexec) {
 #if !defined(HAS_FCNTL) || !defined(F_SETFD)
-	    int fd;
-
 #ifndef NOFILE
 #define NOFILE 20
 #endif
@@ -2178,8 +2180,8 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
     LOCK_FDPID_MUTEX;
     sv = *av_fetch(PL_fdpid,p[This],TRUE);
     UNLOCK_FDPID_MUTEX;
-    (void)SvUPGRADE(sv,SVt_IV);
-    SvIVX(sv) = pid;
+    SvUPGRADE(sv,SVt_IV);
+    SvIV_set(sv, pid);
     PL_forkprocess = pid;
     if (did_pipes && pid > 0) {
 	int errkid;
@@ -2246,6 +2248,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 void
 Perl_atfork_lock(void)
 {
+   dVAR;
 #if defined(USE_ITHREADS)
     /* locks must be held in locking order (if any) */
 #  ifdef MYMALLOC
@@ -2259,6 +2262,7 @@ Perl_atfork_lock(void)
 void
 Perl_atfork_unlock(void)
 {
+    dVAR;
 #if defined(USE_ITHREADS)
     /* locks must be released in same order as in atfork_lock() */
 #  ifdef MYMALLOC
@@ -2303,6 +2307,7 @@ Perl_dump_fds(pTHX_ char *s)
 	    PerlIO_printf(Perl_debug_log," %d",fd);
     }
     PerlIO_printf(Perl_debug_log,"\n");
+    return;
 }
 #endif	/* DUMP_FDS */
 
@@ -2351,6 +2356,7 @@ dup2(int oldfd, int newfd)
 Sighandler_t
 Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
 {
+    dVAR;
     struct sigaction act, oact;
 
 #ifdef USE_ITHREADS
@@ -2390,6 +2396,7 @@ Perl_rsignal_state(pTHX_ int signo)
 int
 Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
 {
+    dVAR;
     struct sigaction act;
 
 #ifdef USE_ITHREADS
@@ -2415,6 +2422,7 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save)
 int
 Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save)
 {
+    dVAR;
 #ifdef USE_ITHREADS
     /* only "parent" interpreter can diddle signals */
     if (PL_curinterp != aTHX)
@@ -2438,19 +2446,18 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
     return PerlProc_signal(signo, handler);
 }
 
-static int sig_trapped;	/* XXX signals are process-wide anyway, so we
-			   ignore the implications of this for threading */
-
 static
 Signal_t
 sig_trap(int signo)
 {
-    sig_trapped++;
+    dVAR;
+    PL_sig_trapped++;
 }
 
 Sighandler_t
 Perl_rsignal_state(pTHX_ int signo)
 {
+    dVAR;
     Sighandler_t oldsig;
 
 #if defined(USE_ITHREADS) && !defined(WIN32)
@@ -2459,10 +2466,10 @@ Perl_rsignal_state(pTHX_ int signo)
 	return SIG_ERR;
 #endif
 
-    sig_trapped = 0;
+    PL_sig_trapped = 0;
     oldsig = PerlProc_signal(signo, sig_trap);
     PerlProc_signal(signo, oldsig);
-    if (sig_trapped)
+    if (PL_sig_trapped)
 	PerlProc_kill(PerlProc_getpid(), signo);
     return oldsig;
 }
@@ -2505,9 +2512,6 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     Pid_t pid2;
     bool close_failed;
     int saved_errno = 0;
-#ifdef VMS
-    int saved_vaxc_errno;
-#endif
 #ifdef WIN32
     int saved_win32_errno;
 #endif
@@ -2525,9 +2529,6 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
 #endif
     if ((close_failed = (PerlIO_close(ptr) == EOF))) {
 	saved_errno = errno;
-#ifdef VMS
-	saved_vaxc_errno = vaxc$errno;
-#endif
 #ifdef WIN32
 	saved_win32_errno = GetLastError();
 #endif
@@ -2549,7 +2550,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     rsignal_restore(SIGQUIT, &qstat);
 #endif
     if (close_failed) {
-	SETERRNO(saved_errno, saved_vaxc_errno);
+	SETERRNO(saved_errno, 0);
 	return -1;
     }
     return(pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status));
@@ -2560,16 +2561,15 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
 I32
 Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
 {
-    I32 result;
+    I32 result = 0;
     if (!pid)
 	return -1;
 #if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
     {
-	SV *sv;
-	SV** svp;
 	char spid[TYPE_CHARS(IV)];
 
 	if (pid > 0) {
+	    SV** svp;
 	    sprintf(spid, "%"IVdf, (IV)pid);
 	    svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE);
 	    if (svp && *svp != &PL_sv_undef) {
@@ -2583,8 +2583,9 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
 
 	    hv_iterinit(PL_pidstatus);
 	    if ((entry = hv_iternext(PL_pidstatus))) {
+		SV *sv = hv_iterval(PL_pidstatus,entry);
+
 		pid = atoi(hv_iterkey(entry,(I32*)statusp));
-		sv = hv_iterval(PL_pidstatus,entry);
 		*statusp = SvIVX(sv);
 		sprintf(spid, "%"IVdf, (IV)pid);
 		(void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD);
@@ -2606,7 +2607,9 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
     goto finish;
 #endif
 #if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME)
+#if defined(HAS_WAITPID) && defined(HAS_WAITPID_RUNTIME)
   hard_way:
+#endif
     {
 	if (flags)
 	    Perl_croak(aTHX_ "Can't do waitpid with flags");
@@ -2618,7 +2621,9 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags)
 	}
     }
 #endif
+#if defined(HAS_WAITPID) || defined(HAS_WAIT4)
   finish:
+#endif
     if (result < 0 && errno == EINTR) {
 	PERL_ASYNC_CHECK();
     }
@@ -2635,8 +2640,8 @@ Perl_pidgone(pTHX_ Pid_t pid, int status)
 
     sprintf(spid, "%"IVdf, (IV)pid);
     sv = *hv_fetch(PL_pidstatus,spid,strlen(spid),TRUE);
-    (void)SvUPGRADE(sv,SVt_IV);
-    SvIVX(sv) = status;
+    SvUPGRADE(sv,SVt_IV);
+    SvIV_set(sv, status);
     return;
 }
 
@@ -2695,7 +2700,7 @@ Perl_repeatcpy(pTHX_ register char *to, register const char *from, I32 len, regi
 
 #ifndef HAS_RENAME
 I32
-Perl_same_dirent(pTHX_ char *a, char *b)
+Perl_same_dirent(pTHX_ const char *a, const char *b)
 {
     char *fa = strrchr(a,'/');
     char *fb = strrchr(b,'/');
@@ -2714,16 +2719,16 @@ Perl_same_dirent(pTHX_ char *a, char *b)
     if (strNE(a,b))
 	return FALSE;
     if (fa == a)
-	sv_setpv(tmpsv, ".");
+	sv_setpvn(tmpsv, ".", 1);
     else
 	sv_setpvn(tmpsv, a, fa - a);
-    if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf1) < 0)
+    if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf1) < 0)
 	return FALSE;
     if (fb == b)
-	sv_setpv(tmpsv, ".");
+	sv_setpvn(tmpsv, ".", 1);
     else
 	sv_setpvn(tmpsv, b, fb - b);
-    if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf2) < 0)
+    if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf2) < 0)
 	return FALSE;
     return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
 	   tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
@@ -2758,6 +2763,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char **searc
     int extidx = 0, i = 0;
     const char *curext = Nullch;
 #else
+    (void)search_ext;
 #  define MAX_EXT_LEN 0
 #endif
 
@@ -2815,7 +2821,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char **searc
     if (strEQ(scriptname, "-"))
  	dosearch = 0;
     if (dosearch) {		/* Look in '.' first. */
-	char *cur = scriptname;
+	const char *cur = scriptname;
 #ifdef SEARCH_EXTS
 	if ((curext = strrchr(scriptname,'.')))	/* possible current ext */
 	    while (ext[i])
@@ -2966,6 +2972,7 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, const char **searc
 void *
 Perl_get_context(void)
 {
+    dVAR;
 #if defined(USE_ITHREADS)
 #  ifdef OLD_PTHREADS_API
     pthread_addr_t t;
@@ -2987,6 +2994,7 @@ Perl_get_context(void)
 void
 Perl_set_context(void *t)
 {
+   dVAR;
 #if defined(USE_ITHREADS)
 #  ifdef I_MACH_CTHREADS
     cthread_set_data(cthread_self(), t);
@@ -2994,12 +3002,14 @@ Perl_set_context(void *t)
     if (pthread_setspecific(PL_thr_key, t))
 	Perl_croak_nocontext("panic: pthread_setspecific");
 #  endif
+#else
+    (void)t;
 #endif
 }
 
 #endif /* !PERL_GET_CONTEXT_DEFINED */
 
-#ifdef PERL_GLOBAL_STRUCT
+#if defined(PERL_GLOBAL_STRUCT) && !defined(PERL_GLOBAL_STRUCT_PRIVATE)
 struct perl_vars *
 Perl_GetVars(pTHX)
 {
@@ -3007,16 +3017,16 @@ Perl_GetVars(pTHX)
 }
 #endif
 
-const char **
+char **
 Perl_get_op_names(pTHX)
 {
- return PL_op_name;
+ return (char **)PL_op_name;
 }
 
-const char **
+char **
 Perl_get_op_descs(pTHX)
 {
- return PL_op_desc;
+ return (char **)PL_op_desc;
 }
 
 const char *
@@ -3028,12 +3038,13 @@ Perl_get_no_modify(pTHX)
 U32 *
 Perl_get_opargs(pTHX)
 {
- return PL_opargs;
+ return (U32 *)PL_opargs;
 }
 
 PPADDR_t*
 Perl_get_ppaddr(pTHX)
 {
+ dVAR;
  return (PPADDR_t*)PL_ppaddr;
 }
 
@@ -3052,7 +3063,7 @@ Perl_getenv_len(pTHX_ const char *env_elem, unsigned long *len)
 MGVTBL*
 Perl_get_vtbl(pTHX_ int vtbl_id)
 {
-    MGVTBL* result = Null(MGVTBL*);
+    const MGVTBL* result = Null(MGVTBL*);
 
     switch(vtbl_id) {
     case want_vtbl_sv:
@@ -3148,7 +3159,7 @@ Perl_get_vtbl(pTHX_ int vtbl_id)
 	result = &PL_vtbl_utf8;
 	break;
     }
-    return result;
+    return (MGVTBL*)result;
 }
 
 I32
@@ -3335,8 +3346,11 @@ Perl_init_tm(pTHX_ struct tm *ptm)	/* see mktime, strftime and asctime */
 {
 #ifdef HAS_TM_TM_ZONE
     Time_t now;
+    struct tm* my_tm;
     (void)time(&now);
-    Copy(localtime(&now), ptm, 1, struct tm);
+    my_tm = localtime(&now);
+    if (my_tm)
+        Copy(my_tm, ptm, 1, struct tm);
 #endif
 }
 
@@ -3612,6 +3626,7 @@ Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, in
   }
 #else
   Perl_croak(aTHX_ "panic: no strftime");
+  return NULL;
 #endif
 }
 
@@ -3659,8 +3674,7 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
 	 * size from the heap if they are given a NULL buffer pointer.
 	 * The problem is that this behaviour is not portable. */
 	if (getcwd(buf, sizeof(buf) - 1)) {
-	    STRLEN len = strlen(buf);
-	    sv_setpvn(sv, buf, len);
+	    sv_setpvn(sv, buf, strlen(buf));
 	    return TRUE;
 	}
 	else {
@@ -3673,11 +3687,10 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
 
     Stat_t statbuf;
     int orig_cdev, orig_cino, cdev, cino, odev, oino, tdev, tino;
-    int namelen, pathlen=0;
-    DIR *dir;
+    int pathlen=0;
     Direntry_t *dp;
 
-    (void)SvUPGRADE(sv, SVt_PV);
+    SvUPGRADE(sv, SVt_PV);
 
     if (PerlLIO_lstat(".", &statbuf) < 0) {
 	SV_CWD_RETURN_UNDEF;
@@ -3689,6 +3702,7 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
     cino = orig_cino;
 
     for (;;) {
+	DIR *dir;
 	odev = cdev;
 	oino = cino;
 
@@ -3711,9 +3725,9 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
 
 	while ((dp = PerlDir_read(dir)) != NULL) {
 #ifdef DIRNAMLEN
-	    namelen = dp->d_namlen;
+	    const int namelen = dp->d_namlen;
 #else
-	    namelen = strlen(dp->d_name);
+	    const int namelen = strlen(dp->d_name);
 #endif
 	    /* skip . and .. */
 	    if (SV_CWD_ISDOT(dp)) {
@@ -3743,7 +3757,7 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
 
 	if (pathlen) {
 	    /* shift down */
-	    Move(SvPVX(sv), SvPVX(sv) + namelen + 1, pathlen, char);
+	    Move(SvPVX_const(sv), SvPVX(sv) + namelen + 1, pathlen, char);
 	}
 
 	/* prepend current directory to the front */
@@ -3765,7 +3779,7 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
 	*SvEND(sv) = '\0';
 	SvPOK_only(sv);
 
-	if (PerlDir_chdir(SvPVX(sv)) < 0) {
+	if (PerlDir_chdir(SvPVX_const(sv)) < 0) {
 	    SV_CWD_RETURN_UNDEF;
 	}
     }
@@ -3918,7 +3932,7 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
 	while (len-- > 0)
 	    av_push((AV *)sv, newSViv(0));
     }
-    return s;
+    return (char *)s;
 }
 
 /*
@@ -3947,7 +3961,7 @@ Perl_new_version(pTHX_ SV *ver)
 	AvREAL_on((AV*)sv);
 	for ( key = 0; key <= av_len(av); key++ )
 	{
-	    I32 rev = SvIV(*av_fetch(av, key, FALSE));
+	    const I32 rev = SvIV(*av_fetch(av, key, FALSE));
 	    av_push((AV *)sv, newSViv(rev));
 	}
 	return rv;
@@ -4331,7 +4345,7 @@ S_socketpair_udp (int fd[2]) {
     errno = ECONNABORTED;
   tidy_up_and_fail:
     {
-	int save_errno = errno;
+	const int save_errno = errno;
 	if (sockets[0] != -1)
 	    PerlLIO_close(sockets[0]);
 	if (sockets[1] != -1)
@@ -4424,7 +4438,15 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
     return 0;
 
   abort_tidy_up_and_fail:
-  errno = ECONNABORTED; /* I hope this is portable and appropriate.  */
+#ifdef ECONNABORTED
+  errno = ECONNABORTED;	/* This would be the standard thing to do. */
+#else
+#  ifdef ECONNREFUSED
+  errno = ECONNREFUSED;	/* E.g. Symbian does not have ECONNABORTED. */
+#  else
+  errno = ETIMEDOUT;	/* Desperation time. */
+#  endif
+#endif
   tidy_up_and_fail:
     {
 	int save_errno = errno;
@@ -4465,6 +4487,7 @@ some level of strict-ness.
 void
 Perl_sv_nosharing(pTHX_ SV *sv)
 {
+    (void)sv;
 }
 
 /*
@@ -4480,6 +4503,7 @@ some level of strict-ness.
 void
 Perl_sv_nolocking(pTHX_ SV *sv)
 {
+    (void)sv;
 }
 
 
@@ -4496,6 +4520,7 @@ some level of strict-ness.
 void
 Perl_sv_nounlocking(pTHX_ SV *sv)
 {
+    (void)sv;
 }
 
 U32
@@ -4605,7 +4630,7 @@ Perl_seed(pTHX)
 #endif
     fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
     if (fd != -1) {
-    	if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
+    	if (PerlLIO_read(fd, (void*)&u, sizeof u) != sizeof u)
 	    u = 0;
 	PerlLIO_close(fd);
 	if (u)
@@ -4669,3 +4694,87 @@ Perl_get_hash_seed(pTHX)
 
      return myseed;
 }
+
+#ifdef PERL_GLOBAL_STRUCT
+
+struct perl_vars *
+Perl_init_global_struct(pTHX)
+{
+    struct perl_vars *plvarsp = NULL;
+#ifdef PERL_GLOBAL_STRUCT
+#  define PERL_GLOBAL_STRUCT_INIT
+#  include "opcode.h" /* the ppaddr and check */
+    IV nppaddr = sizeof(Gppaddr)/sizeof(Perl_ppaddr_t);
+    IV ncheck  = sizeof(Gcheck) /sizeof(Perl_check_t);
+#  ifdef PERL_GLOBAL_STRUCT_PRIVATE
+    /* PerlMem_malloc() because can't use even safesysmalloc() this early. */
+    plvarsp = (struct perl_vars*)PerlMem_malloc(sizeof(struct perl_vars));
+    if (!plvarsp)
+        exit(1);
+#  else
+    plvarsp = PL_VarsPtr;
+#  endif /* PERL_GLOBAL_STRUCT_PRIVATE */
+#  undef PERLVAR
+#  undef PERLVARA
+#  undef PERLVARI
+#  undef PERLVARIC
+#  undef PERLVARISC
+#  define PERLVAR(var,type) /**/
+#  define PERLVARA(var,n,type) /**/
+#  define PERLVARI(var,type,init) plvarsp->var = init;
+#  define PERLVARIC(var,type,init) plvarsp->var = init;
+#  define PERLVARISC(var,init) Copy(init, plvarsp->var, sizeof(init), char);
+#  include "perlvars.h"
+#  undef PERLVAR
+#  undef PERLVARA
+#  undef PERLVARI
+#  undef PERLVARIC
+#  undef PERLVARISC
+#  ifdef PERL_GLOBAL_STRUCT
+    plvarsp->Gppaddr = PerlMem_malloc(nppaddr * sizeof(Perl_ppaddr_t));
+    if (!plvarsp->Gppaddr)
+        exit(1);
+    plvarsp->Gcheck  = PerlMem_malloc(ncheck  * sizeof(Perl_check_t));
+    if (!plvarsp->Gcheck)
+        exit(1);
+    Copy(Gppaddr, plvarsp->Gppaddr, nppaddr, Perl_ppaddr_t); 
+    Copy(Gcheck,  plvarsp->Gcheck,  ncheck,  Perl_check_t); 
+#  endif
+#  ifdef PERL_SET_VARS
+    PERL_SET_VARS(plvarsp);
+#  endif
+#  undef PERL_GLOBAL_STRUCT_INIT
+#endif
+    return plvarsp;
+}
+
+#endif /* PERL_GLOBAL_STRUCT */
+
+#ifdef PERL_GLOBAL_STRUCT
+
+void
+Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
+{
+#ifdef PERL_GLOBAL_STRUCT
+#  ifdef PERL_UNSET_VARS
+    PERL_UNSET_VARS(plvarsp);
+#  endif
+    free(plvarsp->Gppaddr);
+    free(plvarsp->Gcheck);
+#    ifdef PERL_GLOBAL_STRUCT_PRIVATE
+    free(plvarsp);
+#    endif
+#endif
+}
+
+#endif /* PERL_GLOBAL_STRUCT */
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */