From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Fri, 26 Oct 2001 13:03:01 +0000 (+0000)
Subject: Integrate maintperl changes #12268 and #12669;
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=df3728a2a53a64c63edf08a4429a7a57b76ca4aa;p=p5sagit%2Fp5-mst-13.2.git

Integrate maintperl changes #12268 and #12669;

final touches to the audit for statics and thread-unsafe code
* make DB_File, ODBM_File thread-safe
* remove unnecessary/dangerous statics and protect others
  from not getting accidentally enabled under threaded perls

windows support functions get_childdir() et al aren't exported
correctly under vanilla build

Testing under win32 appreciated since changes there had
to be manually merged and I cannot test how badly did I do.

p4raw-link: @12268 on //depot/perlio: bb407f0b8769c638c05e60ebfd157a1e676a6c22

p4raw-id: //depot/perl@12678
p4raw-integrated: from //depot/maint-5.6/perl@12677 'copy in'
	win32/vmem.h (@5902..) 'merge in' ext/DB_File/DB_File.xs
	(@8693..) win32/win32iop.h (@8917..) ext/ODBM_File/ODBM_File.xs
	(@8995..) iperlsys.h (@9154..) scope.c (@9584..) makedef.pl
	(@11425..) gv.c (@12026..) op.c (@12145..) util.c (@12220..)
	toke.c (@12550..) ext/B/B.xs ext/File/Glob/Glob.xs
	ext/Opcode/Opcode.xs ext/re/re.xs (@12653..) mg.c win32/win32.c
	(@12668..)
---

diff --git a/ext/B/B.xs b/ext/B/B.xs
index b2c163a..491c640 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -70,7 +70,7 @@ static char *opclassnames[] = {
     "B::COP"	
 };
 
-#define MY_CXT_KEY "B::_guts"##XS_VERSION
+#define MY_CXT_KEY "B::_guts" XS_VERSION
 
 typedef struct {
     int		x_walkoptree_debug;	/* Flag for walkoptree debug hook */
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 52c7670..0beb9f6 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -463,10 +463,21 @@ extern void __getBerkeleyDBInfo(void);
 #endif
 
 /* Internal Global Data */
-static recno_t Value ; 
-static recno_t zero = 0 ;
-static DB_File CurrentDB ;
-static DBTKEY empty ;
+#define MY_CXT_KEY "DB_File::_guts" XS_VERSION
+
+typedef struct {
+    recno_t	x_Value; 
+    recno_t	x_zero;
+    DB_File	x_CurrentDB;
+    DBTKEY	x_empty;
+} my_cxt_t;
+
+START_MY_CXT
+
+#define Value		(MY_CXT.x_Value)
+#define zero		(MY_CXT.x_zero)
+#define CurrentDB	(MY_CXT.x_CurrentDB)
+#define empty		(MY_CXT.x_empty)
 
 #ifdef DB_VERSION_MAJOR
 
@@ -560,7 +571,8 @@ const DBT * key2 ;
     dTHX;
 #endif    
     dSP ;
-    char * data1, * data2 ;
+    dMY_CXT ;
+    void * data1, * data2 ;
     int retval ;
     int count ;
     
@@ -631,6 +643,7 @@ const DBT * key2 ;
     dTHX;
 #endif    
     dSP ;
+    dMY_CXT ;
     char * data1, * data2 ;
     int retval ;
     int count ;
@@ -709,6 +722,7 @@ HASH_CB_SIZE_TYPE size ;
     dTHX;
 #endif    
     dSP ;
+    dMY_CXT;
     int retval ;
     int count ;
 
@@ -884,6 +898,7 @@ SV *   sv ;
     void *	openinfo = NULL ;
     INFO	* info  = &RETVAL->info ;
     STRLEN	n_a;
+    dMY_CXT;
 
 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
     Zero(RETVAL, 1, DB_File_type) ;
@@ -1157,6 +1172,7 @@ SV *   sv ;
     DB *	dbp ;
     STRLEN	n_a;
     int		status ;
+    dMY_CXT;
 
 /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
     Zero(RETVAL, 1, DB_File_type) ;
@@ -1639,6 +1655,7 @@ MODULE = DB_File	PACKAGE = DB_File	PREFIX = db_
 
 BOOT:
   {
+    MY_CXT_INIT;
     __getBerkeleyDBInfo() ;
  
     DBT_clear(empty) ; 
@@ -1680,6 +1697,8 @@ db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_H
 int
 db_DESTROY(db)
 	DB_File		db
+	PREINIT:
+	  dMY_CXT;
 	INIT:
 	  CurrentDB = db ;
 	CLEANUP:
@@ -1711,6 +1730,8 @@ db_DELETE(db, key, flags=0)
 	DB_File		db
 	DBTKEY		key
 	u_int		flags
+	PREINIT:
+	  dMY_CXT;
 	INIT:
 	  CurrentDB = db ;
 
@@ -1719,6 +1740,8 @@ int
 db_EXISTS(db, key)
 	DB_File		db
 	DBTKEY		key
+	PREINIT:
+	  dMY_CXT;
 	CODE:
 	{
           DBT		value ;
@@ -1736,7 +1759,8 @@ db_FETCH(db, key, flags=0)
 	DBTKEY		key
 	u_int		flags
 	PREINIT:
-	int RETVAL;
+	dMY_CXT ;
+	int RETVAL ;
 	CODE:
 	{
             DBT		value ;
@@ -1755,6 +1779,8 @@ db_STORE(db, key, value, flags=0)
 	DBTKEY		key
 	DBT		value
 	u_int		flags
+	PREINIT:
+	  dMY_CXT;
 	INIT:
 	  CurrentDB = db ;
 
@@ -1763,7 +1789,8 @@ void
 db_FIRSTKEY(db)
 	DB_File		db
 	PREINIT:
-	int RETVAL;
+	dMY_CXT ;
+	int RETVAL ;
 	CODE:
 	{
 	    DBTKEY	key ;
@@ -1782,7 +1809,8 @@ db_NEXTKEY(db, key)
 	DB_File		db
 	DBTKEY		key = NO_INIT
 	PREINIT:
-	int RETVAL;
+	dMY_CXT ;
+	int RETVAL ;
 	CODE:
 	{
 	    DBT		value ;
@@ -1803,6 +1831,8 @@ int
 unshift(db, ...)
 	DB_File		db
 	ALIAS:		UNSHIFT = 1
+	PREINIT:
+	  dMY_CXT;
 	CODE:
 	{
 	    DBTKEY	key ;
@@ -1843,6 +1873,8 @@ unshift(db, ...)
 void
 pop(db)
 	DB_File		db
+	PREINIT:
+	  dMY_CXT;
 	ALIAS:		POP = 1
 	PREINIT:
 	I32 RETVAL;
@@ -1872,6 +1904,8 @@ pop(db)
 void
 shift(db)
 	DB_File		db
+	PREINIT:
+	  dMY_CXT;
 	ALIAS:		SHIFT = 1
 	PREINIT:
 	I32 RETVAL;
@@ -1901,6 +1935,8 @@ shift(db)
 I32
 push(db, ...)
 	DB_File		db
+	PREINIT:
+	  dMY_CXT;
 	ALIAS:		PUSH = 1
 	CODE:
 	{
@@ -1943,6 +1979,8 @@ push(db, ...)
 I32
 length(db)
 	DB_File		db
+	PREINIT:
+	  dMY_CXT;
 	ALIAS:		FETCHSIZE = 1
 	CODE:
 	    CurrentDB = db ;
@@ -1960,6 +1998,8 @@ db_del(db, key, flags=0)
 	DB_File		db
 	DBTKEY		key
 	u_int		flags
+	PREINIT:
+	  dMY_CXT;
 	CODE:
 	  CurrentDB = db ;
 	  RETVAL = db_del(db, key, flags) ;
@@ -1979,6 +2019,8 @@ db_get(db, key, value, flags=0)
 	DBTKEY		key
 	DBT		value = NO_INIT
 	u_int		flags
+	PREINIT:
+	  dMY_CXT;
 	CODE:
 	  CurrentDB = db ;
 	  DBT_clear(value) ; 
@@ -1999,6 +2041,8 @@ db_put(db, key, value, flags=0)
 	DBTKEY		key
 	DBT		value
 	u_int		flags
+	PREINIT:
+	  dMY_CXT;
 	CODE:
 	  CurrentDB = db ;
 	  RETVAL = db_put(db, key, value, flags) ;
@@ -2015,6 +2059,8 @@ db_put(db, key, value, flags=0)
 int
 db_fd(db)
 	DB_File		db
+	PREINIT:
+	dMY_CXT ;
 	CODE:
 	  CurrentDB = db ;
 #ifdef DB_VERSION_MAJOR
@@ -2039,6 +2085,8 @@ int
 db_sync(db, flags=0)
 	DB_File		db
 	u_int		flags
+	PREINIT:
+	  dMY_CXT;
 	CODE:
 	  CurrentDB = db ;
 	  RETVAL = db_sync(db, flags) ;
@@ -2056,6 +2104,8 @@ db_seq(db, key, value, flags)
 	DBTKEY		key 
 	DBT		value = NO_INIT
 	u_int		flags
+	PREINIT:
+	  dMY_CXT;
 	CODE:
 	  CurrentDB = db ;
 	  DBT_clear(value) ; 
diff --git a/ext/File/Glob/Glob.xs b/ext/File/Glob/Glob.xs
index f2210bc..037b85c 100644
--- a/ext/File/Glob/Glob.xs
+++ b/ext/File/Glob/Glob.xs
@@ -4,7 +4,7 @@
 
 #include "bsd_glob.h"
 
-#define MY_CXT_KEY "File::Glob::_guts"##XS_VERSION
+#define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
 
 typedef struct {
     int		x_GLOB_ERROR;
diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
index 5a556bf..3bc94fe 100644
--- a/ext/ODBM_File/ODBM_File.xs
+++ b/ext/ODBM_File/ODBM_File.xs
@@ -81,7 +81,15 @@ typedef datum datum_value ;
 #define odbm_FIRSTKEY(db)			firstkey()
 #define odbm_NEXTKEY(db,key)			nextkey(key)
 
-static int dbmrefcnt;
+#define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION
+
+typedef struct {
+    int		x_dbmrefcnt;
+} my_cxt_t;
+
+START_MY_CXT
+
+#define dbmrefcnt	(MY_CXT.x_dbmrefcnt)
 
 #ifndef DBM_REPLACE
 #define DBM_REPLACE 0
@@ -89,6 +97,11 @@ static int dbmrefcnt;
 
 MODULE = ODBM_File	PACKAGE = ODBM_File	PREFIX = odbm_
 
+BOOT:
+{
+    MY_CXT_INIT;
+}
+
 ODBM_File
 odbm_TIEHASH(dbtype, filename, flags, mode)
 	char *		dbtype
@@ -99,6 +112,8 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
 	{
 	    char *tmpbuf;
 	    void * dbp ;
+	    dMY_CXT;
+
 	    if (dbmrefcnt++)
 		croak("Old dbm can only open one database");
 	    New(0, tmpbuf, strlen(filename) + 5, char);
@@ -126,6 +141,8 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
 void
 DESTROY(db)
 	ODBM_File	db
+	PREINIT:
+	dMY_CXT;
 	CODE:
 	dbmrefcnt--;
 	dbmclose();
diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index c00a5e5..4ef1347 100644
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -7,7 +7,7 @@
 #define OP_MASK_BUF_SIZE (MAXO + 100)
 
 /* XXX op_named_bits and opset_all are never freed */
-#define MY_CXT_KEY "Opcode::_guts"##XS_VERSION
+#define MY_CXT_KEY "Opcode::_guts" XS_VERSION
 
 typedef struct {
     HV *	x_op_named_bits;	/* cache shared for whole process */
diff --git a/ext/re/re.xs b/ext/re/re.xs
index 55f0f75..3188725 100644
--- a/ext/re/re.xs
+++ b/ext/re/re.xs
@@ -17,7 +17,7 @@ extern char*	my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos,
 				    struct re_scream_pos_data_s *data);
 extern SV*	my_re_intuit_string (pTHX_ regexp *prog);
 
-#define MY_CXT_KEY "re::_guts"##XS_VERSION
+#define MY_CXT_KEY "re::_guts" XS_VERSION
 
 typedef struct {
     int		x_oldflag;		/* debug flag */
diff --git a/gv.c b/gv.c
index da50eac..e99b15c 100644
--- a/gv.c
+++ b/gv.c
@@ -411,8 +411,8 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
 GV*
 Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
 {
-    static char autoload[] = "AUTOLOAD";
-    static STRLEN autolen = 8;
+    char autoload[] = "AUTOLOAD";
+    STRLEN autolen = sizeof(autoload)-1;
     GV* gv;
     CV* cv;
     HV* varstash;
diff --git a/iperlsys.h b/iperlsys.h
index d3e8254..97a9a70 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -542,11 +542,6 @@ struct IPerlEnvInfo
 #define PerlEnv_putenv(str)		putenv((str))
 #define PerlEnv_getenv(str)		getenv((str))
 #define PerlEnv_getenv_len(str,l)	getenv_len((str), (l))
-#define PerlEnv_clearenv()		clearenv()
-#define PerlEnv_get_childenv()		get_childenv()
-#define PerlEnv_free_childenv(e)	free_childenv((e))
-#define PerlEnv_get_childdir()		get_childdir()
-#define PerlEnv_free_childdir(d)	free_childdir((d))
 #ifdef HAS_ENVGETENV
 #  define PerlEnv_ENVgetenv(str)	ENVgetenv((str))
 #  define PerlEnv_ENVgetenv_len(str,l)	ENVgetenv_len((str), (l))
@@ -562,6 +557,17 @@ struct IPerlEnvInfo
 #define PerlEnv_sitelib_path(str)	win32_get_sitelib(str)
 #define PerlEnv_vendorlib_path(str)	win32_get_vendorlib(str)
 #define PerlEnv_get_child_IO(ptr)	win32_get_child_IO(ptr)
+#define PerlEnv_clearenv()		win32_clearenv()
+#define PerlEnv_get_childenv()		win32_get_childenv()
+#define PerlEnv_free_childenv(e)	win32_free_childenv((e))
+#define PerlEnv_get_childdir()		win32_get_childdir()
+#define PerlEnv_free_childdir(d)	win32_free_childdir((d))
+#else
+#define PerlEnv_clearenv()		clearenv()
+#define PerlEnv_get_childenv()		get_childenv()
+#define PerlEnv_free_childenv(e)	free_childenv((e))
+#define PerlEnv_get_childdir()		get_childdir()
+#define PerlEnv_free_childdir(d)	free_childdir((d))
 #endif
 
 #endif	/* PERL_IMPLICIT_SYS */
diff --git a/makedef.pl b/makedef.pl
index 54d766f..5fc7b82 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -882,7 +882,11 @@ if ($PLATFORM eq 'win32') {
 			    win32_getpid
 			    win32_crypt
 			    win32_dynaload
-
+			    win32_get_childenv
+			    win32_free_childenv
+			    win32_clearenv
+			    win32_get_childdir
+			    win32_free_childdir
 			    win32_stdin
 			    win32_stdout
 			    win32_stderr
diff --git a/mg.c b/mg.c
index 4e186e0..9b91777 100644
--- a/mg.c
+++ b/mg.c
@@ -959,27 +959,10 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 #if defined(VMS) || defined(EPOC)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
 #else
-#   ifdef PERL_IMPLICIT_SYS
+#   if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
     PerlEnv_clearenv();
 #   else
-#	ifdef WIN32
-    char *envv = GetEnvironmentStrings();
-    char *cur = envv;
-    STRLEN len;
-    while (*cur) {
-	char *end = strchr(cur,'=');
-	if (end && end != cur) {
-	    *end = '\0';
-	    my_setenv(cur,Nullch);
-	    *end = '=';
-	    cur = end + strlen(end+1)+2;
-	}
-	else if ((len = strlen(cur)))
-	    cur += len+1;
-    }
-    FreeEnvironmentStrings(envv);
-#	else
-#ifdef USE_ENVIRON_ARRAY
+#if !defined(MACOS_TRADITIONAL)
 #	    ifndef PERL_USE_SAFE_PUTENV
     I32 i;
 
@@ -992,8 +975,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 
     environ[0] = Nullch;
 
-#endif /* USE_ENVIRON_ARRAY */
-#	endif /* WIN32 */
+#endif /* !defined(MACOS_TRADITIONAL) */
 #   endif /* PERL_IMPLICIT_SYS */
 #endif /* VMS */
     return 0;
@@ -2222,7 +2204,9 @@ Perl_whichsig(pTHX_ char *sig)
     return 0;
 }
 
+#if !defined(PERL_IMPLICIT_CONTEXT)
 static SV* sig_sv;
+#endif
 
 Signal_t
 Perl_sighandler(int sig)
@@ -2290,7 +2274,9 @@ Perl_sighandler(int sig)
     if(PL_psig_name[sig]) {
     	sv = SvREFCNT_inc(PL_psig_name[sig]);
 	flags |= 64;
+#if !defined(PERL_IMPLICIT_CONTEXT)
 	sig_sv = sv;
+#endif
     } else {
 	sv = sv_newmortal();
 	sv_setpv(sv,PL_sig_name[sig]);
@@ -2391,6 +2377,8 @@ unwind_handler_stack(pTHX_ void *p)
     if (flags & 1)
 	PL_savestack_ix -= 5; /* Unprotect save in progress. */
     /* cxstack_ix-- Not needed, die already unwound it. */
+#if !defined(PERL_IMPLICIT_CONTEXT)
     if (flags & 64)
 	SvREFCNT_dec(sig_sv);
+#endif
 }
diff --git a/op.c b/op.c
index 86af481..4740afd 100644
--- a/op.c
+++ b/op.c
@@ -24,10 +24,10 @@
 
 /* #define PL_OP_SLAB_ALLOC */
 
-#ifdef PL_OP_SLAB_ALLOC
+#if defined(PL_OP_SLAB_ALLOC) && !defined(PERL_IMPLICIT_CONTEXT)
 #define SLAB_SIZE 8192
-static char    *PL_OpPtr  = NULL;
-static int     PL_OpSpace = 0;
+static char    *PL_OpPtr  = NULL;	/* XXX threadead */
+static int     PL_OpSpace = 0;		/* XXX threadead */
 #define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0)     \
                               var =  (type *)(PL_OpPtr -= c*sizeof(type));    \
                              else                                             \
diff --git a/scope.c b/scope.c
index 1ce65ef..cc6f13c 100644
--- a/scope.c
+++ b/scope.c
@@ -50,20 +50,12 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
 SV**
 Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
 {
-#if defined(DEBUGGING) && !defined(USE_5005THREADS)
-    static int growing = 0;
-    if (growing++)
-      abort();
-#endif
     PL_stack_sp = sp;
 #ifndef STRESS_REALLOC
     av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
 #else
     av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
 #endif
-#if defined(DEBUGGING) && !defined(USE_5005THREADS)
-    growing--;
-#endif
     return PL_stack_sp;
 }
 
diff --git a/toke.c b/toke.c
index 223cb76..e6d7abc 100644
--- a/toke.c
+++ b/toke.c
@@ -5099,10 +5099,9 @@ Perl_yylex(pTHX)
 	case KEY_write:
 #ifdef EBCDIC
 	{
-	    static char ctl_l[2];
-
-	    if (ctl_l[0] == '\0')
- 		ctl_l[0] = toCTRL('L');
+	    char ctl_l[2];
+	    ctl_l[0] = toCTRL('L');
+	    ctl_l[1] = '\0';
 	    gv_fetchpv(ctl_l,TRUE, SVt_PV);
 	}
 #else
diff --git a/util.c b/util.c
index 29935d2..75f48ef 100644
--- a/util.c
+++ b/util.c
@@ -2285,7 +2285,8 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
     return PerlProc_signal(signo, handler);
 }
 
-static int sig_trapped;
+static int sig_trapped;	/* XXX signals are process-wide anyway, so we
+			   ignore the implications of this for threading */
 
 static
 Signal_t
diff --git a/win32/vmem.h b/win32/vmem.h
index 0fcae27..a0e5eba 100644
--- a/win32/vmem.h
+++ b/win32/vmem.h
@@ -143,6 +143,9 @@ protected:
     long		m_lAllocSize;		    // current alloc size
     long		m_lRefCount;		    // number of current users
     CRITICAL_SECTION	m_cs;			    // access lock
+#ifdef _DEBUG_MEM
+    FILE*		m_pLog;
+#endif
 };
 
 // #define _DEBUG_MEM
@@ -185,6 +188,9 @@ VMem::VMem()
     ASSERT(bRet);
 
     InitializeCriticalSection(&m_cs);
+#ifdef _DEBUG_MEM
+    m_pLog = 0;
+#endif
 
     Init();
 }
@@ -193,6 +199,9 @@ VMem::~VMem(void)
 {
     ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, NULL));
     WALKHEAPTRACE();
+#ifdef _DEBUG_MEM
+    MemoryUsageMessage(NULL, 0, 0, 0);
+#endif
     DeleteCriticalSection(&m_cs);
     BOOL bRet = HeapDestroy(m_hHeap);
     ASSERT(bRet);
@@ -642,21 +651,21 @@ void* VMem::Expand(void* block, size_t size)
 }
 
 #ifdef _DEBUG_MEM
-#define LOG_FILENAME "P:\\Apps\\Perl\\Result.txt"
+#define LOG_FILENAME ".\\MemLog.txt"
 
 void MemoryUsageMessage(char *str, long x, long y, int c)
 {
-    static FILE* fp = NULL;
     char szBuffer[512];
     if(str) {
-	if(!fp)
-	    fp = fopen(LOG_FILENAME, "w");
+	if(!m_pLog)
+	    m_pLog = fopen(LOG_FILENAME, "w");
 	sprintf(szBuffer, str, x, y, c);
-	fputs(szBuffer, fp);
+	fputs(szBuffer, m_pLog);
     }
     else {
-	fflush(fp);
-	fclose(fp);
+	fflush(m_pLog);
+	fclose(m_pLog);
+	m_pLog = 0;
     }
 }
 
diff --git a/win32/win32.c b/win32/win32.c
index 69b7264..115a66c 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1824,6 +1824,8 @@ FAILED:
     return -1;
 }
 
+#ifndef PERL_IMPLICIT_CONTEXT
+
 static UINT timerid = 0;
 
 static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
@@ -1834,9 +1836,12 @@ static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
     CALL_FPTR(PL_sighandlerp)(14);
 }
 
+#endif /* !PERL_IMPLICIT_CONTEXT */
+
 DllExport unsigned int
 win32_alarm(unsigned int sec)
 {
+#ifndef PERL_IMPLICIT_CONTEXT
     /* 
      * the 'obvious' implentation is SetTimer() with a callback
      * which does whatever receiving SIGALRM would do 
@@ -1862,6 +1867,7 @@ win32_alarm(unsigned int sec)
        }
      }
     return 0;
+#endif /* !PERL_IMPLICIT_CONTEXT */
 }
 
 #ifdef HAVE_DES_FCRYPT
@@ -3271,19 +3277,39 @@ GIVE_UP:
  * environment and the current directory to CreateProcess
  */
 
-void*
-get_childenv(void)
+DllExport void*
+win32_get_childenv(void)
 {
     return NULL;
 }
 
-void
-free_childenv(void* d)
+DllExport void
+win32_free_childenv(void* d)
 {
 }
 
-char*
-get_childdir(void)
+DllExport void
+win32_clearenv(void)
+{
+    char *envv = GetEnvironmentStrings();
+    char *cur = envv;
+    STRLEN len;
+    while (*cur) {
+	char *end = strchr(cur,'=');
+	if (end && end != cur) {
+	    *end = '\0';
+	    SetEnvironmentVariable(cur, NULL);
+	    *end = '=';
+	    cur = end + strlen(end+1)+2;
+	}
+	else if ((len = strlen(cur)))
+	    cur += len+1;
+    }
+    FreeEnvironmentStrings(envv);
+}
+
+DllExport char*
+win32_get_childdir(void)
 {
     dTHX;
     char* ptr;
@@ -3302,8 +3328,8 @@ get_childdir(void)
     return ptr;
 }
 
-void
-free_childdir(char* d)
+DllExport void
+win32_free_childdir(char* d)
 {
     dTHX;
     Safefree(d);
@@ -3556,12 +3582,12 @@ win32_putchar(int c)
 
 #ifndef USE_PERL_SBRK
 
-static char *committed = NULL;
-static char *base      = NULL;
-static char *reserved  = NULL;
-static char *brk       = NULL;
-static DWORD pagesize  = 0;
-static DWORD allocsize = 0;
+static char *committed = NULL;		/* XXX threadead */
+static char *base      = NULL;		/* XXX threadead */
+static char *reserved  = NULL;		/* XXX threadead */
+static char *brk       = NULL;		/* XXX threadead */
+static DWORD pagesize  = 0;		/* XXX threadead */
+static DWORD allocsize = 0;		/* XXX threadead */
 
 void *
 sbrk(int need)
diff --git a/win32/win32iop.h b/win32/win32iop.h
index 4d78839..51ddb03 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -145,6 +145,12 @@ DllExport  int		win32_getpid(void);
 
 DllExport char *	win32_crypt(const char *txt, const char *salt);
 
+DllExport void *	win32_get_childenv(void);
+DllExport void		win32_free_childenv(void* d);
+DllExport void		win32_clearenv(void);
+DllExport char *	win32_get_childdir(void);
+DllExport void		win32_free_childdir(char* d);
+
 END_EXTERN_C
 
 /*
@@ -299,6 +305,17 @@ END_EXTERN_C
 #undef crypt
 #define crypt(t,s)		win32_crypt(t,s)
 
+#undef get_childenv
+#undef free_childenv
+#undef clearenv
+#undef get_childdir
+#undef free_childdir
+#define get_childenv()		win32_get_childenv()
+#define free_childenv(d)	win32_free_childenv(d)
+#define clearenv()		win32_clearenv()
+#define get_childdir()		win32_get_childdir()
+#define free_childdir(d)	win32_free_childdir(d)
+
 #undef getenv
 #define getenv win32_getenv
 #undef putenv