[win32] hand-applied patch along with small tweaks

	Message-Id: <35400e2a.13538517@smtp1.ibm.net>
	Subject: Re: Per-Interpreter variables for win32.c

p4raw-id: //depot/win32/perl@894

9 files changed, 105 insertions, 26 deletions

diff --git a/embedvar.h b/embedvar.h
index 667edab2fd..d6c33497a3 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -115,6 +115,8 @@
 #define errgv			(curinterp->Ierrgv)
 #define eval_root		(curinterp->Ieval_root)
 #define eval_start		(curinterp->Ieval_start)
+#define exitlist		(curinterp->Iexitlist)
+#define exitlistlen		(curinterp->Iexitlistlen)
 #define fdpid			(curinterp->Ifdpid)
 #define filemode		(curinterp->Ifilemode)
 #define firstgv			(curinterp->Ifirstgv)
@@ -125,6 +127,7 @@
 #define incgv			(curinterp->Iincgv)
 #define initav			(curinterp->Iinitav)
 #define inplace			(curinterp->Iinplace)
+#define intern			(curinterp->Iintern)
 #define lastfd			(curinterp->Ilastfd)
 #define lastscream		(curinterp->Ilastscream)
 #define lastsize		(curinterp->Ilastsize)
@@ -146,6 +149,7 @@
 #define minus_l			(curinterp->Iminus_l)
 #define minus_n			(curinterp->Iminus_n)
 #define minus_p			(curinterp->Iminus_p)
+#define modglobal		(curinterp->Imodglobal)
 #define multiline		(curinterp->Imultiline)
 #define mystrk			(curinterp->Imystrk)
 #define ofmt			(curinterp->Iofmt)
@@ -231,6 +235,8 @@
 #define Ierrgv			errgv
 #define Ieval_root		eval_root
 #define Ieval_start		eval_start
+#define Iexitlist		exitlist
+#define Iexitlistlen		exitlistlen
 #define Ifdpid			fdpid
 #define Ifilemode		filemode
 #define Ifirstgv		firstgv
@@ -241,6 +247,7 @@
 #define Iincgv			incgv
 #define Iinitav			initav
 #define Iinplace		inplace
+#define Iintern			intern
 #define Ilastfd			lastfd
 #define Ilastscream		lastscream
 #define Ilastsize		lastsize
@@ -262,6 +269,7 @@
 #define Iminus_l		minus_l
 #define Iminus_n		minus_n
 #define Iminus_p		minus_p
+#define Imodglobal		modglobal
 #define Imultiline		multiline
 #define Imystrk			mystrk
 #define Iofmt			ofmt
@@ -408,6 +416,8 @@
 #define errgv			Perl_errgv
 #define eval_root		Perl_eval_root
 #define eval_start		Perl_eval_start
+#define exitlist		Perl_exitlist
+#define exitlistlen		Perl_exitlistlen
 #define fdpid			Perl_fdpid
 #define filemode		Perl_filemode
 #define firstgv			Perl_firstgv
@@ -418,6 +428,7 @@
 #define incgv			Perl_incgv
 #define initav			Perl_initav
 #define inplace			Perl_inplace
+#define intern			Perl_intern
 #define lastfd			Perl_lastfd
 #define lastscream		Perl_lastscream
 #define lastsize		Perl_lastsize
@@ -439,6 +450,7 @@
 #define minus_l			Perl_minus_l
 #define minus_n			Perl_minus_n
 #define minus_p			Perl_minus_p
+#define modglobal		Perl_modglobal
 #define multiline		Perl_multiline
 #define mystrk			Perl_mystrk
 #define ofmt			Perl_ofmt
diff --git a/interp.sym b/interp.sym
index 3e06da36ed..fba6ba78bd 100644
--- a/interp.sym
+++ b/interp.sym
@@ -44,6 +44,8 @@ envgv
 errgv
 eval_root
 eval_start
+exitlist
+exitlistlen
 fdpid
 filemode
 firstgv
@@ -56,6 +58,7 @@ in_eval
 incgv
 initav
 inplace
+intern
 last_in_gv
 lastfd
 lastscream
@@ -80,6 +83,7 @@ minus_c
 minus_l
 minus_n
 minus_p
+modglobal
 multiline
 mystrk
 nrs
diff --git a/intrpvar.h b/intrpvar.h
index 59f7e098db..7c5ba7602c 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -152,6 +152,15 @@ PERLVAR(Iors,		char *)		/* $\ */
 PERLVAR(Iorslen,	STRLEN)		
 PERLVAR(Iofmt,		char *)		/* $# */
 
+/* interpreter atexit processing */
+PERLVARI(Iexitlist,	PerlExitListEntry *, NULL)	/* list of exit functions */
+PERLVARI(Iexitlistlen,	I32, 0)				/* length of same */
+PERLVAR(Imodglobal,	HV *)				/* per-interp module data */
+
+#ifdef HAVE_INTERP_INTERN
+PERLVAR(Iintern,	struct interp_intern)		/* platform internals */
+#endif
+
 #ifdef USE_THREADS
 PERLVAR(Ithrsv,		SV *)		/* holds struct perl_thread for main thread */
 PERLVARI(Ithreadnum,	U32,	0)	/* incremented each thread creation */
diff --git a/perl.c b/perl.c
index a4e82333e9..52ad7ca9c2 100644
--- a/perl.c
+++ b/perl.c
@@ -208,9 +208,10 @@ perl_construct(register PerlInterpreter *sv_interp)
     localpatches = local_patches;	/* For possible -v */
 #endif
 
-    PerlIO_init();      /* Hook to IO system */
+    PerlIO_init();			/* Hook to IO system */
 
-    fdpid = newAV();	/* for remembering popen pids by fd */
+    fdpid = newAV();			/* for remembering popen pids by fd */
+    modglobal = newHV();		/* pointers to per-interpreter module globals */
 
     DEBUG( {
 	New(51,debname,128,char);
@@ -351,6 +352,12 @@ perl_destruct(register PerlInterpreter *sv_interp)
     SvREFCNT_dec(parsehook);
     parsehook = Nullsv;
 
+    /* call exit list functions */
+    while (exitlistlen-- > 0)
+	exitlist[exitlistlen].fn(exitlist[exitlistlen].ptr);
+
+    Safefree(exitlist);
+
     if (destruct_level == 0){
 
 	DEBUG_P(debprofdump());
@@ -552,6 +559,15 @@ perl_free(PerlInterpreter *sv_interp)
     Safefree(sv_interp);
 }
 
+void
+perl_atexit(void (*fn) (void *), void *ptr)
+{
+    Renew(exitlist, exitlistlen+1, PerlExitListEntry);
+    exitlist[exitlistlen].fn = fn;
+    exitlist[exitlistlen].ptr = ptr;
+    ++exitlistlen;
+}
+
 int
 perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env)
 {
diff --git a/perl.h b/perl.h
index 27e7241838..9be32457de 100644
--- a/perl.h
+++ b/perl.h
@@ -1645,6 +1645,12 @@ typedef enum {
 #define PERLVARI(var,type,init) type var;
 #define PERLVARIC(var,type,init) type var;
 
+/* Interpreter exitlist entry */
+typedef struct exitlistentry {
+    void (*fn) _((void*));
+    void *ptr;
+} PerlExitListEntry;
+
 #ifdef PERL_GLOBAL_STRUCT
 struct perl_vars {
 #include "perlvars.h"
diff --git a/proto.h b/proto.h
index 7641071b08..eb75dc4ee3 100644
--- a/proto.h
+++ b/proto.h
@@ -371,6 +371,7 @@ void	pad_reset _((void));
 void	pad_swipe _((PADOFFSET po));
 void	peep _((OP* o));
 PerlInterpreter*	perl_alloc _((void));
+void    perl_atexit _((void(*fn)(void *), void*));
 I32	perl_call_argv _((char* subname, I32 flags, char** argv));
 I32	perl_call_method _((char* methname, I32 flags));
 I32	perl_call_pv _((char* subname, I32 flags));
diff --git a/win32/makedef.pl b/win32/makedef.pl
index 4cd93b621a..acb60a892c 100644
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -373,6 +373,7 @@ __DATA__
 perl_init_i18nl10n
 perl_init_ext
 perl_alloc
+perl_atexit
 perl_construct
 perl_destruct
 perl_free
diff --git a/win32/win32.c b/win32/win32.c
index 4879fcbf0c..9cee6b51fa 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -73,34 +73,29 @@ static BOOL		has_redirection(char *ptr);
 static long		filetime_to_clock(PFILETIME ft);
 static BOOL		filetime_from_time(PFILETIME ft, time_t t);
 
-char *	w32_perlshell_tokens = Nullch;
-char **	w32_perlshell_vec;
-long	w32_perlshell_items = -1;
-DWORD	w32_platform = (DWORD)-1;
-char	w32_perllib_root[MAX_PATH+1];
 HANDLE	w32_perldll_handle = INVALID_HANDLE_VALUE;
-#ifndef __BORLANDC__
-long	w32_num_children = 0;
-HANDLE	w32_child_pids[MAXIMUM_WAIT_OBJECTS];
-#endif
+static DWORD	w32_platform = (DWORD)-1;
 
 #ifdef USE_THREADS
 #  ifdef USE_DECLSPEC_THREAD
 __declspec(thread) char	strerror_buffer[512];
 __declspec(thread) char	getlogin_buffer[128];
+__declspec(thread) char	w32_perllib_root[MAX_PATH+1];
 #    ifdef HAVE_DES_FCRYPT
 __declspec(thread) char	crypt_buffer[30];
 #    endif
 #  else
 #    define strerror_buffer	(thr->i.Wstrerror_buffer)
 #    define getlogin_buffer	(thr->i.Wgetlogin_buffer)
+#    define w32_perllib_root	(thr->i.Ww32_perllib_root)
 #    define crypt_buffer	(thr->i.Wcrypt_buffer)
 #  endif
 #else
-char	strerror_buffer[512];
-char	getlogin_buffer[128];
+static char	strerror_buffer[512];
+static char	getlogin_buffer[128];
+static char	w32_perllib_root[MAX_PATH+1];
 #  ifdef HAVE_DES_FCRYPT
-char	crypt_buffer[30];
+static char	crypt_buffer[30];
 #  endif
 #endif
 
@@ -117,8 +112,10 @@ IsWinNT(void) {
 char *
 win32_perllib_path(char *sfx,...)
 {
+    dTHR;
     va_list ap;
     char *end;
+
     va_start(ap,sfx);
     GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE) 
 		      ? GetModuleHandle(NULL)
@@ -868,7 +865,7 @@ win32_utime(const char *filename, struct utimbuf *times)
 DllExport int
 win32_wait(int *status)
 {
-#ifdef __BORLANDC__
+#ifdef USE_RTL_WAIT
     return wait(status);
 #else
     /* XXX this wait emulation only knows about processes
@@ -1393,7 +1390,7 @@ win32_pipe(int *pfd, unsigned int size, int mode)
 DllExport FILE*
 win32_popen(const char *command, const char *mode)
 {
-#ifdef USE_CRT_POPEN
+#ifdef USE_RTL_POPEN
     return _popen(command, mode);
 #else
     int p[2];
@@ -1452,7 +1449,8 @@ win32_popen(const char *command, const char *mode)
 
     /* close saved handle */
     win32_close(oldfd);
-    sv_setiv(*av_fetch(fdpid, p[parent], TRUE), childpid);
+
+    sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
 
     /* we have an fd, return a file stream */
     return (win32_fdopen(p[parent], (char *)mode));
@@ -1467,7 +1465,7 @@ cleanup:
     }
     return (NULL);
 
-#endif /* USE_CRT_POPEN */
+#endif /* USE_RTL_POPEN */
 }
 
 /*
@@ -1477,18 +1475,18 @@ cleanup:
 DllExport int
 win32_pclose(FILE *pf)
 {
-#ifdef USE_CRT_POPEN
+#ifdef USE_RTL_POPEN
     return _pclose(pf);
 #else
 
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
     int child;
 #endif
 
     int childpid, status;
     SV *sv;
 
-    sv = *av_fetch(fdpid, win32_fileno(pf), TRUE);
+    sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
     if (SvIOK(sv))
 	childpid = SvIVX(sv);
     else
@@ -1502,7 +1500,7 @@ win32_pclose(FILE *pf)
     win32_fclose(pf);
     SvIVX(sv) = 0;
 
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
     for (child = 0 ; child < w32_num_children ; ++child) {
 	if (w32_child_pids[child] == (HANDLE)childpid) {
 	    Copy(&w32_child_pids[child+1], &w32_child_pids[child],
@@ -1523,7 +1521,7 @@ win32_pclose(FILE *pf)
     return (status);
 #endif
 
-#endif /* USE_CRT_OPEN */
+#endif /* USE_RTL_POPEN */
 }
 
 DllExport int
@@ -1618,13 +1616,13 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 {
     int status;
 
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
     if (mode == P_NOWAIT && w32_num_children >= MAXIMUM_WAIT_OBJECTS)
 	return -1;
 #endif
 
     status = spawnvp(mode, cmdname, (char * const *) argv);
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
     /* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId
      * while VC RTL returns pinfo.hProcess. For purposes of the custom
      * implementation of win32_wait(), we assume the latter.
@@ -2121,6 +2119,13 @@ Perl_init_os_extras()
     char *file = __FILE__;
     dXSUB_SYS;
 
+    w32_perlshell_tokens = Nullch;
+    w32_perlshell_items = -1;
+    w32_fdpid = newAV();		/* XXX needs to be in Perl_win32_init()? */
+#ifndef USE_RTL_WAIT
+    w32_num_children = 0;
+#endif
+
     /* these names are Activeware compatible */
     newXS("Win32::GetCwd", w32_GetCwd, file);
     newXS("Win32::SetCwd", w32_SetCwd, file);
@@ -2163,7 +2168,7 @@ Perl_win32_init(int *argcp, char ***argvp)
 #if !defined(_ALPHA_) && !defined(__GNUC__)
     _control87(MCW_EM, MCW_EM);
 #endif
-    MALLOC_INIT; 
+    MALLOC_INIT;
 }
 
 #ifdef USE_BINMODE_SCRIPTS
diff --git a/win32/win32.h b/win32/win32.h
index 781c720ed0..9990caf7eb 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -119,6 +119,8 @@ struct tms {
 #pragma warn -csu	/* "comparing signed and unsigned values" */
 #pragma warn -pro	/* "call to function with no prototype" */
 
+#define USE_RTL_WAIT	/* Borland has a working wait() */
+
 #endif
 
 #ifdef _MSC_VER			/* Microsoft Visual C++ */
@@ -216,6 +218,28 @@ EXT void win32_strip_return(struct sv *sv);
 #define win32_strip_return(sv) NOOP
 #endif
 
+#define HAVE_INTERP_INTERN
+struct interp_intern {
+    char *	w32_perlshell_tokens;
+    char **	w32_perlshell_vec;
+    long	w32_perlshell_items;
+    struct av *	w32_fdpid;
+#ifndef USE_RTL_WAIT
+    long	w32_num_children;
+    HANDLE	w32_child_pids[MAXIMUM_WAIT_OBJECTS];
+#endif
+};
+
+#define w32_perlshell_tokens	(intern.w32_perlshell_tokens)
+#define w32_perlshell_vec	(intern.w32_perlshell_vec)
+#define w32_perlshell_items	(intern.w32_perlshell_items)
+#define w32_fdpid		(intern.w32_fdpid)
+
+#ifndef USE_RTL_WAIT
+#  define w32_num_children	(intern.w32_num_children)
+#  define w32_child_pids	(intern.w32_child_pids)
+#endif
+
 /* 
  * Now Win32 specific per-thread data stuff 
  */
@@ -229,6 +253,7 @@ struct thread_intern {
     char		Wstrerror_buffer[512];
     struct servent	Wservent;
     char		Wgetlogin_buffer[128];
+    char		Ww32_perllib_root[MAX_PATH+1];
 #    ifdef USE_SOCKETS_AS_HANDLES
     int			Winit_socktype;
 #    endif