tweaks for building with -DUSE_ITHREADS on !WIN32 platforms;

fix bug where lc($readonly) could result in bogus errors

p4raw-id: //depot/perl@4660

10 files changed, 57 insertions, 19 deletions

diff --git a/embed.h b/embed.h
index 9e331fba72..a768cb6690 100644
--- a/embed.h
+++ b/embed.h
@@ -49,6 +49,8 @@
 #else
 #endif
 #if defined(USE_ITHREADS)
+#  if defined(USE_IMPLICIT_SYS)
+#  endif
 #endif
 #if defined(MYMALLOC)
 #define malloced_size		Perl_malloced_size
@@ -1462,6 +1464,8 @@
 #else
 #endif
 #if defined(USE_ITHREADS)
+#  if defined(USE_IMPLICIT_SYS)
+#  endif
 #endif
 #if defined(MYMALLOC)
 #define malloced_size		Perl_malloced_size
@@ -2848,6 +2852,8 @@
 #else
 #endif
 #if defined(USE_ITHREADS)
+#  if defined(USE_IMPLICIT_SYS)
+#  endif
 #endif
 #if defined(MYMALLOC)
 #define malloc			Perl_malloc
diff --git a/embed.pl b/embed.pl
index 978b13c7f2..e54512498c 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1040,12 +1040,14 @@ jno	|int	|perl_parse	|PerlInterpreter* interp|XSINIT_t xsinit \
 				|int argc|char** argv|char** env
 #if defined(USE_ITHREADS)
 jno	|PerlInterpreter*|perl_clone|PerlInterpreter* interp, UV flags
+#  if defined(USE_IMPLICIT_SYS)
 jno	|PerlInterpreter*|perl_clone_using|PerlInterpreter *interp|UV flags \
 				|struct IPerlMem* m|struct IPerlMem* ms \
 				|struct IPerlMem* mp|struct IPerlEnv* e \
 				|struct IPerlStdIO* io|struct IPerlLIO* lio \
 				|struct IPerlDir* d|struct IPerlSock* s \
 				|struct IPerlProc* p
+#  endif
 #endif
 
 #if defined(MYMALLOC)
diff --git a/iperlsys.h b/iperlsys.h
index 222d88bfb9..0d9f699513 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -293,6 +293,7 @@ struct IPerlStdIOInfo
 
 #include "perlsdio.h"
 #include "perl.h"
+#define PerlIO_fdupopen(f)		(f)
 
 #endif	/* PERL_IMPLICIT_SYS */
 
diff --git a/makedef.pl b/makedef.pl
index 4b1b84f31a..1d585a2e31 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -425,6 +425,7 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
 unless ($define{'PERL_IMPLICIT_SYS'}) {
     skip_symbols [qw(
 		    perl_alloc_using
+		    perl_clone_using
 		    )];
 }
 
@@ -747,6 +748,8 @@ __DATA__
 # extra globals not included above.
 perl_alloc
 perl_alloc_using
+perl_clone
+perl_clone_using
 perl_construct
 perl_destruct
 perl_free
diff --git a/objXSUB.h b/objXSUB.h
index b28c69a7ec..62d61b1b85 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -823,6 +823,8 @@
 #else
 #endif
 #if defined(USE_ITHREADS)
+#  if defined(USE_IMPLICIT_SYS)
+#  endif
 #endif
 #if defined(MYMALLOC)
 #endif
diff --git a/perlapi.c b/perlapi.c
index c5f91b48a8..776025530f 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -43,6 +43,8 @@ START_EXTERN_C
 #else
 #endif
 #if defined(USE_ITHREADS)
+#  if defined(USE_IMPLICIT_SYS)
+#  endif
 #endif
 #if defined(MYMALLOC)
 #endif
diff --git a/pp.c b/pp.c
index f404883308..c14a05ce7a 100644
--- a/pp.c
+++ b/pp.c
@@ -2261,7 +2261,7 @@ PP(pp_ucfirst)
 	
 	tend = uv_to_utf8(tmpbuf, uv);
 
-	if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+	if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
 	    dTARGET;
 	    sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
 	    sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
@@ -2273,7 +2273,7 @@ PP(pp_ucfirst)
 	}
     }
     else {
-	if (!SvPADTMP(sv)) {
+	if (!SvPADTMP(sv) || SvREADONLY(sv)) {
 	    dTARGET;
 	    sv_setsv(TARG, sv);
 	    sv = TARG;
@@ -2318,7 +2318,7 @@ PP(pp_lcfirst)
 	
 	tend = uv_to_utf8(tmpbuf, uv);
 
-	if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+	if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
 	    dTARGET;
 	    sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
 	    sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
@@ -2330,7 +2330,7 @@ PP(pp_lcfirst)
 	}
     }
     else {
-	if (!SvPADTMP(sv)) {
+	if (!SvPADTMP(sv) || SvREADONLY(sv)) {
 	    dTARGET;
 	    sv_setsv(TARG, sv);
 	    sv = TARG;
@@ -2397,7 +2397,7 @@ PP(pp_uc)
 	}
     }
     else {
-	if (!SvPADTMP(sv)) {
+	if (!SvPADTMP(sv) || SvREADONLY(sv)) {
 	    dTARGET;
 	    sv_setsv(TARG, sv);
 	    sv = TARG;
@@ -2468,7 +2468,7 @@ PP(pp_lc)
 	}
     }
     else {
-	if (!SvPADTMP(sv)) {
+	if (!SvPADTMP(sv) || SvREADONLY(sv)) {
 	    dTARGET;
 	    sv_setsv(TARG, sv);
 	    sv = TARG;
@@ -4852,9 +4852,13 @@ PP(pp_pack)
 		     * of pack() (and all copies of the result) are
 		     * gone.
 		     */
-		    if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+		    if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr)
+						|| (SvPADTMP(fromstr)
+						    && !SvREADONLY(fromstr))))
+		    {
 			Perl_warner(aTHX_ WARN_UNSAFE,
 				"Attempt to pack pointer to temporary value");
+		    }
 		    if (SvPOK(fromstr) || SvNIOK(fromstr))
 			aptr = SvPV(fromstr,n_a);
 		    else
diff --git a/pp_sys.c b/pp_sys.c
index 6599285d41..8a1c98ce04 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -3602,7 +3602,7 @@ PP(pp_fork)
     PUSHi(childpid);
     RETURN;
 #else
-#  if defined(USE_ITHREADS) && defined(WIN32)
+#  if defined(USE_ITHREADS) && defined(USE_IMPLICIT_SYS)
     djSP; dTARGET;
     Pid_t childpid;
 
@@ -3800,7 +3800,7 @@ PP(pp_exec)
 #endif
     }
 
-#ifdef USE_ITHREADS
+#if !defined(HAS_FORK) && defined(USE_ITHREADS) && defined(USE_IMPLICIT_SYS)
     if (value >= 0)
 	my_exit(value);
 #endif
diff --git a/proto.h b/proto.h
index 0225128e0d..f057294201 100644
--- a/proto.h
+++ b/proto.h
@@ -20,7 +20,9 @@ PERL_CALLCONV int	perl_run(PerlInterpreter* interp);
 PERL_CALLCONV int	perl_parse(PerlInterpreter* interp, XSINIT_t xsinit, int argc, char** argv, char** env);
 #if defined(USE_ITHREADS)
 PERL_CALLCONV PerlInterpreter*	perl_clone(PerlInterpreter* interp, UV flags);
+#  if defined(USE_IMPLICIT_SYS)
 PERL_CALLCONV PerlInterpreter*	perl_clone_using(PerlInterpreter *interp, UV flags, struct IPerlMem* m, struct IPerlMem* ms, struct IPerlMem* mp, struct IPerlEnv* e, struct IPerlStdIO* io, struct IPerlLIO* lio, struct IPerlDir* d, struct IPerlSock* s, struct IPerlProc* p);
+#  endif
 #endif
 
 #if defined(MYMALLOC)
diff --git a/sv.c b/sv.c
index 1eb7972452..933151ccfe 100644
--- a/sv.c
+++ b/sv.c
@@ -6526,13 +6526,23 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl)
 #endif
 
 PerlInterpreter *
-perl_clone(PerlInterpreter *my_perl, UV flags)
+perl_clone(PerlInterpreter *proto_perl, UV flags)
 {
 #ifdef PERL_OBJECT
-    CPerlObj *pPerl = (CPerlObj*)my_perl;
+    CPerlObj *pPerl = (CPerlObj*)proto_perl;
 #endif
-    return perl_clone_using(my_perl, flags, PL_Mem, PL_MemShared, PL_MemParse,
-			    PL_Env, PL_StdIO, PL_LIO, PL_Dir, PL_Sock, PL_Proc);
+
+#ifdef PERL_IMPLICIT_SYS
+    return perl_clone_using(proto_perl, flags,
+			    proto_perl->IMem,
+			    proto_perl->IMemShared,
+			    proto_perl->IMemParse,
+			    proto_perl->IEnv,
+			    proto_perl->IStdIO,
+			    proto_perl->ILIO,
+			    proto_perl->IDir,
+			    proto_perl->ISock,
+			    proto_perl->IProc);
 }
 
 PerlInterpreter *
@@ -6550,23 +6560,23 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     IV i;
     SV *sv;
     SV **svp;
-#ifdef PERL_OBJECT
+#  ifdef PERL_OBJECT
     CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO,
 					ipD, ipS, ipP);
     PERL_SET_INTERP(pPerl);
-#else
+#  else		/* !PERL_OBJECT */
     PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
     PERL_SET_INTERP(my_perl);
 
-#  ifdef DEBUGGING
+#    ifdef DEBUGGING
     memset(my_perl, 0xab, sizeof(PerlInterpreter));
     PL_markstack = 0;
     PL_scopestack = 0;
     PL_savestack = 0;
     PL_retstack = 0;
-#  else
+#    else	/* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
-#  endif
+#    endif	/* DEBUGGING */
 
     /* host pointers */
     PL_Mem		= ipM;
@@ -6578,7 +6588,13 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_Dir		= ipD;
     PL_Sock		= ipS;
     PL_Proc		= ipP;
-#endif
+#  endif	/* PERL_OBJECT */
+#else		/* !PERL_IMPLICIT_SYS */
+    IV i;
+    SV *sv;
+    SV **svp;
+    PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
+#endif		/* PERL_IMPLICIT_SYS */
 
     /* arena roots */
     PL_xiv_arenaroot	= NULL;