summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-10-26 13:03:01 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-10-26 13:03:01 +0000
commitdf3728a2a53a64c63edf08a4429a7a57b76ca4aa (patch)
tree41cb3c77a25414e4bf6259507dfbadcbc2ea463d
parent9ece3ee6650e9c2f6d5131c19ae5e80f2a8bfc4a (diff)
downloadperl-df3728a2a53a64c63edf08a4429a7a57b76ca4aa.tar.gz
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..)
-rw-r--r--ext/B/B.xs2
-rw-r--r--ext/DB_File/DB_File.xs66
-rw-r--r--ext/File/Glob/Glob.xs2
-rw-r--r--ext/ODBM_File/ODBM_File.xs19
-rw-r--r--ext/Opcode/Opcode.xs2
-rw-r--r--ext/re/re.xs2
-rw-r--r--gv.c4
-rw-r--r--iperlsys.h16
-rw-r--r--makedef.pl6
-rw-r--r--mg.c30
-rw-r--r--op.c6
-rw-r--r--scope.c8
-rw-r--r--toke.c7
-rw-r--r--util.c3
-rw-r--r--win32/vmem.h23
-rw-r--r--win32/win32.c54
-rw-r--r--win32/win32iop.h17
17 files changed, 188 insertions, 79 deletions
diff --git a/ext/B/B.xs b/ext/B/B.xs
index b2c163a4eb..491c640c68 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 52c7670f9b..0beb9f6f26 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 f2210bcd04..037b85cc47 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 5a556bfd2f..3bc94fe073 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 c00a5e528b..4ef1347b45 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 55f0f75884..31887255a1 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 da50eac235..e99b15c58e 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 d3e82549b4..97a9a70505 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 54d766f6c5..5fc7b821f3 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 4e186e0c5f..9b91777631 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 86af481158..4740afd1f1 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 1ce65efe20..cc6f13c9b9 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 223cb76bd9..e6d7abc372 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 29935d2dad..75f48ef978 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 0fcae27a6c..a0e5eba070 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 69b7264404..115a66cac7 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 4d78839888..51ddb03752 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