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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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